Compare column A with several columns and copy the non-existent one

[sofas]

Hello, I have this code to fetch the values in column A and not in column C and copy them after the last cell that contains a value from column C. I want to execute the same command on several columns, so that column A is compared to columns C through R, and the non-existent ones are copied in each column separately.

Sub test()

Dim lr As Long, i As Long
Dim WS As Worksheet: Set WS = Worksheets("data")
 Application.ScreenUpdating = False
lr = WS.Columns("A:R").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    For i = 5 To lr
  

    If WorksheetFunction.CountIf(Range("C5:C" & lr), Range("A" & i)) = 0 Then
    Cells(Rows.Count, 3).End(xlUp).Offset(1).Value = Range("a" & i).Value
     End If
    
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Trebor76]

Hi sofas,

Try this:

Option Explicit
Sub test()

    Dim lr As Long, i As Long, j As Long
    Dim strCol As String
    Dim WS As Worksheet: Set WS = Worksheets("data")
    
    Application.ScreenUpdating = False
    
    lr = WS.Columns("A:R").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    
    For i = 3 To 18 'Columns C to R
        strCol = Split((WS.Columns(i).Address(, 0)), ":")(0) 'Though not necessary I find using the actual column letter as opposed to its number much easier to follow
        For j = 5 To lr
            If WorksheetFunction.CountIf(WS.Range(strCol & "5:" & strCol & lr), WS.Range("A" & j)) = 0 Then
                WS.Cells(Rows.Count, strCol).End(xlUp).Offset(1).Value = WS.Range("A" & j).Value
            End If
        Next j
    Next i
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[sofas]

Hi sofas,

Try this:

Option Explicit
Sub test()

    Dim lr As Long, i As Long, j As Long
    Dim strCol As String
    Dim WS As Worksheet: Set WS = Worksheets("data")
   
    Application.ScreenUpdating = False
   
    lr = WS.Columns("A:R").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
   
    For i = 3 To 18 'Columns C to R
        strCol = Split((WS.Columns(i).Address(, 0)), ":")(0) 'Though not necessary I find using the actual column letter as opposed to its number much easier to follow
        For j = 5 To lr
            If WorksheetFunction.CountIf(WS.Range(strCol & "5:" & strCol & lr), WS.Range("A" & j)) = 0 Then
                WS.Cells(Rows.Count, strCol).End(xlUp).Offset(1).Value = WS.Range("A" & j).Value
            End If
        Next j
    Next i
   
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

Thank you, this is what is really needed
. amazing.........

 

[Trebor76]

Thank you, this is what is really needed
. amazing.........

Thanks for letting us know and you're welcome