Macro to Compare 2 Worksheets and Generate a Sheet with Differences

Hi,

I’m an engineer who needs a macro to help with the following task in excel. I have a huge quantity of data to process in the following way.

I have excel workbooks that consists of 2 work sheets.

Both are Parts Lists with quantities, one is before a refurbishment and one is after a refurbishment.

Both lists are very similar except for a few minor differences (changes from the refurbishment)

I want a macro to generate a list on a third worksheet that is only the parts or extra quantities of parts that is not on the first worksheet.

To give a worked example:

Worksheet 1

Image1.png

Worksheet 2

Image2.png


Worksheet 3 Generated by the Macro

Image3.png

So anything new introduced by worksheet 2 should move into worksheet 3, but for instance if it is on worksheet 1 and not on 2 like Part_D it does not need to be added to the list in 3. The purpose of this is to enable me to order new parts. The part numbers are always unique, although the numbers of part are large and varied and not necessarily the same between worksheet 1 and worksheet 2.

I’d really appreciate if someone could show me a good way to do this .

Try

Sub test()
    Dim a, i As Long, e
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each e In [{"Sheet1","Sheet2"}]
            a = Sheets(e).Cells(1).CurrentRegion.Value
            If Not .exists(a(1, 1)) Then .Item(a(1, 1)) = a(1, 2)
            For i = 2 To UBound(a, 1)
                .Item(a(i, 1)) = .Item(a(i, 1)) + a(i, 2)
            Next
        Next
        Sheets("sheet3").Cells(1).Resize(.Count, 2).Value = _
                Application.Transpose(Array(.keys, .items))
    End With
End S

Thanks for the quick reply, this is adding the lists together though rather than show the differences as per my example. How would I alter it to correct this issue?

If this is not how you wanted, post a workbook. Picture doesn't help at all.

Sub test()
    Dim a, i As Long, n As Long, w, x
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        a = Sheets("sheet1").Cells(1).CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            .Item(a(i, 1)) = a(i, 2)
        Next
        a = Sheets("sheet2").Cells(1).CurrentRegion.Value: n = 1
        For i = 2 To UBound(a, 1)
            If .exists(a(i, 1)) Then
                x = .Item(a(i, 1)) - a(i, 2)
                If x = 0 Then .Remove a(i, 1)
            Else
                x = a(i, 2)
            End If
            If x <> 0 Then
                n = n + 1
                a(n, 1) = a(i, 1): a(n, 2) = x
            End If
        Next
        If .Count Then w = Application.Transpose(Array(.keys, .items)): i = .Count
    End With
    With Sheets("sheet3").Cells(1).Resize(, 2)
        .Resize(n).Value = a
        If IsArray(w) Then .Offset(n).Resize(i).Value = w
    End With
End Sub