CODEWITHSUNDEEP
vbaexcel
SantaSecrets
SantaSecrets

Reputation: 37

Compare 2 sets of data and paste any missing values on another sheet

So I have a master sheet with 1000+ rows and another sheet that "should" have the same data. however, in reality sometimes some is missing from the master and sometimes some is missing from the query run.
for simplicity purposes let's say the unique ID is in column B. here's my code but it's super slow and it only does a 1-way comparison.

My ideal code would be something that runs a little smoother and gives me the missing data from both the master and the query.

Is there's something wrong with the way I'm asking the question please let me know.

Sub FindMissing()

    Dim lastRowE As Integer
    Dim lastRowF As Integer
    Dim lastRowM As Integer
    Dim foundTrue As Boolean


    lastRowE = Sheets("Master").Cells(Sheets("Master").Rows.Count, "B").End(xlUp).Row
    lastRowF = Sheets("Qry").Cells(Sheets("Qry").Rows.Count, "B").End(xlUp).Row
    lastRowM = Sheets("Mismatch").Cells(Sheets("Mismatch").Rows.Count, "B").End(xlUp).Row



    For i = 1 To lastRowE
        foundTrue = False
        For j = 1 To lastRowF
            If Sheets("Master").Cells(i, 2).Value = Sheets("Qry").Cells(j, 2).Value Then
                foundTrue = True
                Exit For
            End If
        Next j
        If Not foundTrue Then
            Sheets("Master").Rows(i).Copy Destination:= _
            Sheets("Mismatch").Rows(lastRowM + 1)
            lastRowM = lastRowM + 1
        End If
    Next i

End Sub

Upvotes: 1

Views: 1369

Answers (1)

user4039065
user4039065

Reputation:

Don't loop through the cells on the worksheet. Collect all of the values into variant arrays and process in-memory.

Option Explicit

Sub YouSuckAtVBA()

    Dim i As Long, mm As Long
    Dim valsM As Variant, valsQ As Variant, valsMM As Variant

    With Worksheets("Master")
        valsM = .Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
    End With

    With Worksheets("Qry")
        valsQ = .Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
    End With

    ReDim valsMM(1 To (UBound(valsM, 1) + UBound(valsQ, 1)), 1 To 2)
    mm = 1
    valsMM(mm, 1) = "value"
    valsMM(mm, 2) = "missing from"

    For i = LBound(valsM, 1) To UBound(valsM, 1)
        If IsError(Application.Match(valsM(i, 1), valsQ, 0)) Then
            mm = mm + 1
            valsMM(mm, 1) = valsM(i, 1)
            valsMM(mm, 2) = "qry"
        End If
    Next i

    For i = LBound(valsQ, 1) To UBound(valsQ, 1)
        If IsError(Application.Match(valsQ(i, 1), valsM, 0)) Then
            mm = mm + 1
            valsMM(mm, 1) = valsQ(i, 1)
            valsMM(mm, 2) = "master"
        End If
    Next i

    valsMM = helperResizeArray(valsMM, mm)

    With Worksheets("Mismatch")
        With .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Resize(UBound(valsMM, 1), UBound(valsMM, 2)) = valsMM
        End With
    End With

End Sub

Function helperResizeArray(vals As Variant, x As Long)
    Dim arr As Variant, i As Long

    ReDim arr(1 To x, 1 To 2)

    For i = LBound(arr, 1) To UBound(arr, 1)
        arr(i, 1) = vals(i, 1)
        arr(i, 2) = vals(i, 2)
    Next i

    helperResizeArray = arr
End Function

You cannot resize the first rank of a 2D array so I've added a helper function that will resize the results before putting them back into the Mismatch worksheet.

Upvotes: 5

Related Questions