Nested loop

[Brutusar]

Hi, I have two Sheets, 1 and 2. Both have two columns with values, A and B. Both of these may have several thousands of rows. I need to compare these two sheets to find rows that are present in Sheet1 but not in Sheet2.

I have written a code for this, but as it takes forever to run without doing very much I guess there is at least one major mistake in the code. Anyone have time to have a quick look and give me a hint in the right direction?

Sub FindMissingValues()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim range1 As Range
    Dim range2 As Range
    Dim cell As Range
    Dim found As Boolean
    
    ' Set the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    
    ' Set the ranges to loop through
    Set range1 = ws1.Range("A:B")
    Set range2 = ws2.Range("A:B")
    
    ' Loop through each cell in Sheet1 range "A:B"
    For Each cell In range1
        ' Reset found flag
        found = False
        
        ' Loop through each cell in Sheet2 range "A:B"
        For Each c In range2
            ' Check if the value in Sheet1 is present in Sheet2
            If cell.Value = c.Value Then
                found = True
                Exit For
            End If
        Next c
        
        ' If the value is not found in Sheet2, copy it to Sheet3
        If Not found Then
            cell.Copy ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Offset(1)
        End If
    Next cell
End Sub

 

[nemmi69]

See if this helps
After the Dim's and the line

Application.ScreenUpdating = False

After the last Next and the line
Application.ScreenUpdating = True

 

[Brutusar]

Hi, I am doing that already, just in separate subs. She sub was still running for more than 8 hours before it went in to "unresponsive" and had to be stopped using task manager

 

[nemmi69]

I think the issue may be that you are doing the entire column, so 1048576 rows. So may be better to restrict the rows it searches. See if this is better.

Option Explicit
Sub FindMissingValues()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim range1 As Range
    Dim range2 As Range
    Dim c As Variant
    Dim cell As Range
    Dim found As Boolean
    Dim LastRowWs1 As Long
    Dim LastRowWs2 As Long
    Dim LastRowWs3 As Long

    ' Set the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    
LastRowWs1 = ws1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRowWs2 = ws2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRowWs3 = ws3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ' Set the ranges to loop through
    Set range1 = ws1.Range("A1:B" & LastRowWs1)
    Set range2 = ws2.Range("A1:B" & LastRowWs2)
    
    ' Loop through each cell in Sheet1 range "A:B"
    For Each cell In range1
        ' Reset found flag
        found = False
        
        ' Loop through each cell in Sheet2 range "A:B"
        For Each c In range2
            ' Check if the value in Sheet1 is present in Sheet2
            If cell.Value = c.Value Then
                found = True
                Exit For
            End If
        Next c
        
        ' If the value is not found in Sheet2, copy it to Sheet3
        If Not found Then
            cell.Copy ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Offset(1)
        End If
    Next cell
End Sub

 

[Akuini]

Another option:
Note: the code uses col A in those 3 sheets to determine the last row with data.

Sub FindMissingValues()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim n As Long, j As Long
    Dim va, vb, x
    Dim d As Object
    Dim t As Double
    
    t = Timer
    ' Set the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    
    va = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    vb = ws2.Range("A1", ws2.Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    
    ReDim vc(1 To UBound(vb, 1) * 2, 1 To 1)
    Set d = CreateObject("scripting.dictionary"):    d.CompareMode = vbTextCompare
    For Each x In va
        d(x) = Empty
    Next
    
    For Each x In vb
       If Not d.exists(x) Then
            j = j + 1
            vc(j, 1) = x
       End If
    Next
    n = Range("A" & Rows.Count).End(xlUp).Row
    ws3.Range("A" & n + 1).Resize(j, 1) = vc
    Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

 

[Alex Blakenburg]

You might want to add "ws3." in the 4th last line of @Akuini solution.
n = ws3.range("A" .....

 

[Akuini]

You might want to add "ws3." in the 4th last line of @Akuini solution.
n = ws3.range("A" .....

Good catch, thank you.

@Brutusar
The code in post #5, this part:

n = Range("A" & Rows.Count).End(xlUp).Row

should be:

n = ws3.Range("A" & Rows.Count).End(xlUp).Row

So, try this one instead:

Sub FindMissingValues()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim n As Long, j As Long
    Dim va, vb, x
    Dim d As Object
    Dim t As Double
    
    t = Timer
    ' Set the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    
    va = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    vb = ws2.Range("A1", ws2.Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    
    ReDim vc(1 To UBound(vb, 1) * 2, 1 To 1)
    Set d = CreateObject("scripting.dictionary"):    d.CompareMode = vbTextCompare
    For Each x In va
        d(x) = Empty
    Next
    
    For Each x In vb
       If Not d.exists(x) Then
            j = j + 1
            vc(j, 1) = x
       End If
    Next
    n = ws3.Range("A" & Rows.Count).End(xlUp).Row
    ws3.Range("A" & n + 1).Resize(j, 1) = vc
    Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

 

[Brutusar]

Thanks, that works much faster. It may be my explanation, but I do get the differences in Sheet1 and Sheet2 all in col A in Sheet3. So it looks like the code is comparing the columns independently, not as a row where the data in col A and B belongs together

 

[Akuini]

Thanks, that works much faster. It may be my explanation, but I do get the differences in Sheet1 and Sheet2 all in col A in Sheet3. So it looks like the code is comparing the columns independently, not as a row where the data in col A and B belongs together

Try this one:
I'm assuming that pipeline character "|" doesn't exist in your data.

Sub FindMissingValues_2()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim n As Long, j As Long
    Dim va, vb, x
    Dim d As Object
    Dim t As Double
    
    t = Timer
    ' Set the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    
    va = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    vb = ws2.Range("A1", ws2.Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
    
    ReDim vc(1 To UBound(va, 1), 1 To 2)
    Set d = CreateObject("scripting.dictionary"):    d.CompareMode = vbTextCompare
    
    For i = 1 To UBound(vb, 1)
        d(vb(i, 1) & "|" & vb(i, 2)) = Empty
    Next
    
    For i = 1 To UBound(va, 1)
        x = va(i, 1) & "|" & va(i, 2)
       If Not d.exists(x) Then
            j = j + 1
            s = Split(x, "|")
            vc(j, 1) = s(0)
            vc(j, 2) = s(1)
       End If
    Next
    n = ws3.Range("A" & Rows.Count).End(xlUp).Row
    ws3.Range("A" & n + 1).Resize(j, 2) = vc
    Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

 

[kevin9999]

@Akuini very nice solution Tried it with 100k rows on sheet 1, 50k rows on sheet 2, completed in under 1.4 seconds.