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.

17529

[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.