VBA compare two columns and list cells that match and the ones that don't

[paazan]

Hi guys,

First time user here.
I'm also a beginner and here's what I need to do.
I have a workbook containing two sheets, "Sheet1" and "Sheet2", each has a column of the same type of data. I need to compare these two columns, if there's any data that match, I'd like to copy or cut it and place it in a third sheet, "Sheet3" in a column that titled "Match", and if any of the cells in Sheet1 but not Sheet2, I want to put it in the same third sheet but a different column "Sheet1Only", if anything in Sheet2 but not Sheet1, then list it in another column "Sheet2Only".

I have the code that does the first step of listing every matching cells, but I don't know how to find the ones that don't match and list them, because my code scans every possible pair and if does not match it'll copy and past it tend to generate duplicates.

Here's my code, please help:

Sub ComparePO()
Dim x As Long, y As Long, erow As Long
Dim isMatch As Boolean
Dim xLastRow As Long, yLastRow As Long
xLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
yLastRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
matchrow = 2
UnmatchRow = 2
For x = 2 To xLastRow
For y = 2 To yLastRow
If Worksheets("Sheet1").Cells(x, 2) = Worksheets("Sheet2").Cells(y, 4) Then
isMatch = True
Worksheets("Sheet1").Cells(x, 1).Copy Worksheets("Sheet3").Cells(matchrow, 1)
matchrow = matchrow + 1
                End If
            Next y
     Next x
   End Sub

[onlyadrafter]

Hello,th
is seems a bit long winded, but its been a really long day. Have assumed column B on sheets 1 and 2 are available.

Sheet 3 column A = matches, column B = sheet 1 only and column C = sheet 2 only.

Sub FIND_WITH_FORMULA()    Application.ScreenUpdating = False
    Sheets("Sheet1").Select
    Range("B1").Formula = "=match(A1,Sheet2!A:A,0)"
    Range("B1").Copy
    Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial (xlPasteAll)
    Application.CutCopyMode = False
    With Range("A1:B1")
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:=">0", Operator:=xlAnd
    End With
    Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Sheet3").Range("A2").PasteSpecial (xlPasteValues)
    With Range("A1:B1")
        .AutoFilter
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:="=#N/A"
    End With
    Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Sheet3").Range("B2").PasteSpecial (xlPasteValues)
    Range("A1:B1").AutoFilter
    Columns("B:B").ClearContents
    Sheets("Sheet2").Select
    Range("B1").Formula = "=match(A1,Sheet1!A:A,0)"
    Range("B1").Copy
    Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial (xlPasteAll)
    Application.CutCopyMode = False
    With Range("A1:B1")
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:="=#N/A"
    End With
    Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Sheet3").Range("C2").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    Range("A1:B1").AutoFilter
    Columns("B:B").ClearContents
    Application.ScreenUpdating = True
End Sub

[mancubus]

welcome to the forum.

uploading an example file always helps.

try below. change destination column letters where necessary.

Sub vbax_57665_compare_two_cols_list_match_unmatch()

    Dim arr1, arr2
    Dim i As Long
    
    arr1 = Worksheets("Sheet1").Cells(1).CurrentRegion.Offset(1).Value
    arr2 = Worksheets("Sheet2").Cells(1).CurrentRegion.Offset(1).Value

    arr1 = Application.Transpose(arr1)
    arr2 = Application.Transpose(arr2)

    For i = LBound(arr1) To UBound(arr1)
        If UBound(Filter(arr2, arr1(i))) > -1 Then
            Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = arr1(i) 'Match
        Else
            Worksheets("Sheet3").Range("C" & Rows.Count).End(xlUp).Offset(1).Value = arr1(i) 'Sheet1Only
        End If
    Next i
        
    For i = LBound(arr2) To UBound(arr2)
        If UBound(Filter(arr1, arr2(i))) = -1 Then
            Worksheets("Sheet3").Range("E" & Rows.Count).End(xlUp).Offset(1).Value = arr2(i) 'Sheet2Only
        End If
    Next i
        
End Sub

[paazan]

Thanks a lot for your prompt reply. Seems both of you use more advanced logic and programmers, which is great and I'd love to learn.
I have your code, but was not not working. My apology that I didn't describe the situation clearly.
Here's a simplified document attached, please take a look at it.


If you open the document you can see that all three sheets are set up. What I'm trying to compare is the Column B in sheet1 and Column D in sheet2.
If any match, copy the cell to sheet3 column A. If exists in sheet1 but not sheet2, copy the cell to sheet3 column C, if exists is sheet2 but not sheet1, copy to sheet3 column E.

Comparison - test 2.xlsm

[mancubus]

let's keep it simple then

Sub vbax_57665_compare_two_cols_list_match_unmatch()

    Dim rng1 As Range, rng2 As Range
    Dim LastRow1 As Long, LastRow2 As Long, i As Long
    
    Worksheets("Sheet3").Range("A2:E" & Rows.Count).Clear
    Worksheets("Sheet3").Range("A2:E" & Rows.Count).NumberFormat = "@"
    
    With Worksheets("Sheet1")
        LastRow1 = .Range("B" & .Rows.Count).End(xlUp).Row
        Set rng1 = .Range("B2:B" & LastRow1)
    End With
    
    With Worksheets("Sheet2")
        LastRow2 = .Range("D" & .Rows.Count).End(xlUp).Row
        Set rng2 = .Range("D2:D" & LastRow2)
    End With
    
    With Worksheets("Sheet1")
        For i = 2 To LastRow1
            If Application.CountIf(rng2, .Range("B" & i).Value) > 0 Then
                Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = .Range("B" & i).Value 'Match
            Else
                Worksheets("Sheet3").Range("C" & Rows.Count).End(xlUp).Offset(1).Value = .Range("B" & i).Value 'Sheet1Only
            End If
        Next i
    End With
    
    With Worksheets("Sheet2")
        For i = 2 To LastRow2
            If Application.CountIf(rng1, .Range("D" & i).Value) = 0 Then
                Worksheets("Sheet3").Range("E" & Rows.Count).End(xlUp).Offset(1).Value = .Range("D" & i).Value 'Sheet2Only
            End If
        Next i
    End With
    
End Sub

Numbers like 16-1927 are quite likely to be interpreted as Dates. So i changed Sheet3's A-E cols' format to @, which is text.

[paazan]

It worked like a charm!!!
Thanks a lot.

I'll adjust the code as needed in my actual situation and extend it to doing a little more.
Obviously you use this Range and Application sentence that I need to learn more about so I might have further questions later.

Thanks again.

[mancubus]

you are welcome.
for future references, please mark the thread as solved from threadtools dromdown.