VBA For Each Loop and Else condition

November 28, 2024

Now my macro works for "If Col N find a match in Col Y then copy values from Col Z [Y Offset(0, 1)] back to Col N"


  Set DEST = Sheets("Mil")
  Set DATA = Sheets("Scr")
  Set Rng1 = DATA.Range(Range("Y2"), DATA.Range("Y" & Rows.Count).End(xlUp)) ' Data to copy from
  Set Rng2 = DATA.Range(Range("N2"), DATA.Range("N" & Rows.Count).End(xlUp)) ' Data to replace
  For Each c In Rng2
  
    On Error Resume Next
    
           ' If Col N find the match in Col Y then copy Z [Y Offset(0, 1)] to Col N
    
    Rng1.Find(What:=c).Offset(0, 1).COPY Destination:=c.Offset(0, 0)
    
         
    Err.Clear

  Next c

I would like to add following condition:

"If Col N doesn’t find a match in Col Y then add Col N value to the last row of Col Y and sort Col Y:Z alphabetically"

Any help appreciated…

>Solution :

As highlighted in Dai‘s comment, it’s best to avoid using "On Error Resume Next" unless you are certain that a specific error needs to be deliberately ignored.
If no matching data is found in Column Y, the Find method returns Nothing. In such cases, attempting to reference the result directly will raise a runtime error. I assume that’s why you’ve used On Error Resume Next in your script.

Rng1.Find(What:=c).Offset(0, 1).COPY Destination:=c.Offset(0, 0)

Set Rng1 = DATA.Range(Range("Y2"), DATA.Range("Y" & Rows.Count).End(xlUp)) is equivalent to Set Rng1 = DATA.Range(ActiveSheet.Range("Y2"), DATA.Range("Y" & Rows.Count).End(xlUp)). If the active sheet is not DATA, this code will trigger error 1004.

Pls try:

  Set DEST = Sheets("Mil")
  Set Data = Sheets("Scr")
  Set Rng1 = Data.Range("Y2", Data.Range("Y" & Data.Rows.Count).End(xlUp)) ' Data to copy from
  Set Rng2 = Data.Range("N2", Data.Range("N" & Data.Rows.Count).End(xlUp)) ' Data to replace
  Dim ce As Range
  For Each c In Rng2
    Set ce = Nothing
    Set ce = Rng1.Find(What:=c.Value, LookIn:=xlValues, lookat:=xlWhole)
    If ce Is Nothing Then ' no matching in Col Y
        With Rng1.Cells(Rng1.Count)
            .Value = .Value + c.Value
        End With
    Else
        ce.Offset(0, 1).Copy c
    End If
  Next c