Comparing two sheets for differences in rows and copy to different sheet

Brutusar

Board Regular
Joined
Nov 23, 2019
Messages
166
Office Version
  1. 365
Platform
  1. Windows
Hi, I have a relatively simple task to do, but do not manage do get the code do exactly as need.

  • I have three sheets, "All_Products", "Out_Of_Stock" and "Summary". All sheets has data in col A and B only. Col A holds product names, Col B product numbers.
  • All_Products has over 2000 rows. "Out_Of_Stock" has only some of the products, and can have any number of rows.
  • I need to compare these two sheets and find the products (rows) that are in the sheet" All_Products", but NOT in "Out_Of_Stock", and copy these to sheet "Summary".
So, sheet "Summary" should contain all rows in sheet "All_Products" MINUS the rows in "Out_Of_Stock".

I have been doing some coding but it is not giving the correct results, apart from being slow. This is my latest attempt:


VBA Code:
Sub FindMissingRows()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim j As Long
    
    Set ws1 = ThisWorkbook.Worksheets("All_Products")
    Set ws2 = ThisWorkbook.Worksheets("Out_Of_Stock")
    Set ws3 = ThisWorkbook.Worksheets("Summary")
    
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lastRow1
        Dim foundMatch As Boolean
        foundMatch = False
        
        For j = 1 To lastRow2
            If ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value And _
               ws1.Cells(i, 2).Value = ws2.Cells(j, 2).Value And _
               ws1.Cells(i, 3).Value = ws2.Cells(j, 3).Value Then
               
                foundMatch = True
                Exit For
            End If
        Next j
        
        If Not foundMatch Then
            ws1.Rows(i).Copy ws3.Cells(ws3.Cells(ws3.Rows.Count, 1).End(xlUp).Row + 1, 1)
        End If
    Next i
End Sub


Any thoughts of what I am doing wrong here?
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Hi
Try the
VBA Code:
Sub test()
    Dim a, b
    Dim i&
    a = Sheets("All_Products").Cells(1).CurrentRegion
    b = Sheets("Out_Of_Stock").Cells(1).CurrentRegion
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a): If Not .exists(a(i, 1) & a(i, 2)) Then .Add a(i, 1) & a(i, 2), Array(a(i, 1), a(i, 2))
        Next
        For i = 2 To UBound(b): If .exists(b(i, 1) & b(i, 2)) Then .Remove ((b(i, 1) & b(i, 2)))
        Next
        Sheets("Summary").Cells(2, 1).Resize(.Count, 2) = Application.Index(.items, 0, 0)
    End With
End Sub
 
Upvote 0
Just to clarify, if you only have data in 2 columns (A & B) why is your current code checking 3 columns?
 
Upvote 0

Forum statistics

Threads
1,215,068
Messages
6,122,950
Members
449,095
Latest member
nmaske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top