VBA - Compare lists then Compile differences

[byoung70104]

Hello,
I am fairly novice with Excel VBA and in searching the forum I haven't quite found what I'm looking for.
I'm using Excel 2007 however writing in compatability mode for other users who use Excel 2003.

I have three worksheets in one workbook, "List1", "List2", "Results". List 1 and 2 contain a single column of serial numbers, Results contains two columns "Extra in list 1" and "Extra in List 2". I have it broken the data into two sheets because users will scan serial numbers into list 1 while list 2 will be generated by another macro i have that reformats a report that the user will paste into the List 2 Sheet. The results sheet is separate because it will give the user a summary.

I would like to look at each cell in List 1 and see if it's in List 2, if it is, then I'd like to move to the next cell. If it is Not in list 2, I'd like to put it into the "Extra in list 1" section of the Results sheet.

Once I complete List 1, I'd like to look at each item in list 2 and see if its in List 1, if it is - move on, if it is not - Put it into the "Extra in list 2" section of the results sheet.

I hope this makes sense...here's what it would look like (in the regular version the macro could be comparing up to 1000 serial numbers).


LIST 1
[TABLE="class: grid, width: 150"]
<TBODY>[TR]
[TD]Serial Numbers
[/TD]
[/TR]
[TR]
[TD]12345
[/TD]
[/TR]
[TR]
[TD]12346
[/TD]
[/TR]
[TR]
[TD]12347
[/TD]
[/TR]
[TR]
[TD]12349
[/TD]
[/TR]
</TBODY>[/TABLE]


LIST 2
[TABLE="class: grid, width: 150"]
<TBODY>[TR]
[TD]Serial Numbers
[/TD]
[/TR]
[TR]
[TD]12345
[/TD]
[/TR]
[TR]
[TD]12346
[/TD]
[/TR]
[TR]
[TD]12348
[/TD]
[/TR]
[TR]
[TD]12341
[/TD]
[/TR]
</TBODY>[/TABLE]


RESULTS Sheet
[TABLE="class: grid, width: 400"]
<TBODY>[TR]
[TD]EXTRA ON LIST 1
[/TD]
[TD][/TD]
[TD]EXTRA ON LIST 2
[/TD]
[/TR]
[TR]
[TD]12347
[/TD]
[TD][/TD]
[TD]12348
[/TD]
[/TR]
[TR]
[TD]12349
[/TD]
[TD][/TD]
[TD]12341
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]




I hope this all makes sense, please let me know if there is any other information I could provide to clarify my questions.

Thank you for your time!
-BY

 

[JLGWhiz]

Hi byoung70104, Welcome to MrExcel Forum and Message Board.
You can edit the sheet names in the Set statements to suit your purposes. Other than that, the code tested OK.

Sub divide()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
Set sh3 = Sheets(3) 'Edit sheet name
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row with data for both list sheets
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A2:A" & lr1) 'Establish the ranges on both sheets
Set rng2 = sh2.Range("A2:A" & lr2)
With sh3 'If header not there, put them in
    If .Range("A1") = "" And .Range("B1") = "" Then
        .Range("A1") = "Extras in List 1"
        .Range("B1") = "Extras in List 2"
    End If
End With
    For Each c In rng1 'Run a loop for each list ID mismatches and paste to sheet 3.
        If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
            sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
        End If
    Next
    For Each c In rng2
        If Application.CountIf(rng1, c.Value) = 0 Then
            sh3.Cells(Rows.Count, 2).End(xlUp)(2) = c.Value
        End If
    Next
End Sub

 

[byoung70104]

JLGWhiz, you are fantastic! The code is working...so far I haven't broken it.


Thank you so much for your help! I will respond back to this post if I run into any trouble.

 

[JLGWhiz]

JLGWhiz, you are fantastic! The code is working...so far I haven't broken it.


Thank you so much for your help! I will respond back to this post if I run into any trouble.

You would probably do better to start a new thread if you have additional issues. I will be unsubscribing to this one.

Regards, JLG

 

[Edwardryez]

Hi byoung70104, Welcome to MrExcel Forum and Message Board.
You can edit the sheet names in the Set statements to suit your purposes. Other than that, the code tested OK.

Sub divide()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
Set sh3 = Sheets(3) 'Edit sheet name
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row with data for both list sheets
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A2:A" & lr1) 'Establish the ranges on both sheets
Set rng2 = sh2.Range("A2:A" & lr2)
With sh3 'If header not there, put them in
    If .Range("A1") = "" And .Range("B1") = "" Then
        .Range("A1") = "Extras in List 1"
        .Range("B1") = "Extras in List 2"
    End If
End With
    For Each c In rng1 'Run a loop for each list ID mismatches and paste to sheet 3.
        If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
            sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
        End If
    Next
    For Each c In rng2
        If Application.CountIf(rng1, c.Value) = 0 Then
            sh3.Cells(Rows.Count, 2).End(xlUp)(2) = c.Value
        End If
    Next
End Sub

Great Macro, How can we add another range that shows the same items?

 

[TexasChaz]

Hi. This appears to be code that is ALMOST exactly what I need to compare serial number lists. The only difference is that my sht1 list starts in cell F10 (header in F9) and my sht2 list starts in cell B3 (header in B2). And I only need the results of sht1 list that were not found in the sht2 list. I've tried changing the A2:A ranges to my ranges (F10:F & B3:B) and it doesn't work. Appreciate any help.