Identifying/Pulling Differences in Data/Reports

[doyen]

Summary: I am trying to find a macro that pulls differences in data into another sheet. I believe a macro would be best in this scenario but any assistance would be much appreciated!

Scenario: I have two reports. One in each sheet. Both reports have identifying numbers in column A that correspond to a category i.e. "1234" = Travel. Column B has a dollar amount associated with column A category/number. I am trying to compare both reports based on these identifying numbers (column A) to find any discrepancies in dollar amounts (column B) then pull these differences in another sheet.

Example of data below:

Sheet 1:
Column A Column B
10601110D8Z $200.00
20602234D8Z $120.00
30603000D8Z $150.00

Sheet 2:
Column A Column B
10601110D8Z $150.00
20602234D8Z $120.00
30603000D8Z $300.00

Sample Result (Sheet 3):

Sheet 1 Sheet 2
10601110D8Z $200.00 $150.00
30603000D8Z $150.00 $300.00


It seems like a simple solution exists but I was unable to create a macro based on my online research. If anyone can provide any guidance or references, that would be great!


Thank you!

 

[mumps]

Assuming your data starts at cell A1, try this macro. Change the cell reference (in red) to suit your needs. Make sure you have a sheet named "Result".

Sub MatchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, sh1 As Worksheet, sh2 As Worksheet, arr1 As Variant, arr2 As Variant
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Set desWS = Sheets("Result")
    Dim LastRow As Long
    arr1 = sh1.Range("A1", sh1.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    arr2 = sh2.Range("A1", sh2.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    Set rnglist = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        If Not rnglist.Exists(arr1(i, 1)) Then
            rnglist.Add Key:=arr1(i, 1), Item:=arr1(i, 2)
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        If rnglist.Exists(arr2(i, 1)) Then
            If arr1(i, 2) <> arr2(i, 2) Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).Value = Array(arr1(i, 1), arr1(i, 2), arr2(i, 2))
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[doyen]

This code worked perfectly for the scenario I provided above. However when analyzing the results I realized that I failed to recognize that in my data there are identifying numbers in column A in Sheet 1 that do not exist in Sheet 2. There are also duplicate identifying numbers (column A) in Sheet 1 that are not duplicated in column A in Sheet 2. This in turn is throwing off the results that would otherwise be perfect. Perhaps I can manipulate the data to account for/eliminate duplicates prior to applying this macro.

Thank you for the response! I have seen your avatar in many of my google searches regarding excel VBA I feel like I received a response from a celebrity.

 

[mumps]

Thank you for the kind words. If you use the XL2BB add-in (button on the ribbon) you can post a screen shot of what your data actually looks like and perhaps we can come up with a solution.