matching data from 2 sources (excel 2007)

[gvanhook]

Good day loungers!
I have a situation where I could use some advice. I have 2 lists of data that are each 2 columns wide each containing the same fields from 2 different data sources. I need to compare the data in each list and any entry that is different or not included in the opposite list needs to be indicated somehow as different. I would like to do this with a macro that I can run as this process is run multiple times per month.

I currently just put the lists side by side and then sort them by the column that identifies the person (this value should be unique per data set) and where the numbers don’t match on a row insert cells in whichever data set I need to make the data line up in rows. After the data is matched this way I can then manually enter an explanation as to why the data is different.

I have included a sample spreadsheet. Data set 1 & data set 2 contains a sanitized and shortened version of the data sets. Typically the data will contain 2000 to 2500 rows. Combined data takes the same data puts it side by side and expected results shows the end result I need.
Any assistance that can be given would be appreciated.

Thanks in advance,
Greg

[HansV]

Hi Greg,

Welcome to Eileen's Lounge!

Try this macro:

Code: Select all

Sub CreateListOfDifferences()
  Dim wsh1 As Worksheet
  Dim wsh2 As Worksheet
  Dim wshN As Worksheet
  Dim r As Long
  Dim m1 As Long
  Dim m2 As Long
  Const intColor = 6 ' Yellow

  Application.ScreenUpdating = False
  Set wshN = Worksheets.Add
  wshN.Name = "New Sheet"

  Set wsh1 = Worksheets("Data Set 1")
  m1 = wsh1.Cells(wsh1.Rows.Count, 1).End(xlUp).Row
  wsh1.Range("A1:B" & m1).Copy Destination:=wshN.Range("A1")
  wshN.Range("A:B").Sort Key1:=wshN.Range("A1"), Header:=xlYes

  Set wsh2 = Worksheets("Data Set 2")
  m2 = wsh2.Cells(wsh2.Rows.Count, 1).End(xlUp).Row
  wsh2.Range("A1:B" & m2).Copy Destination:=wshN.Range("C1")
  wshN.Range("C:D").Sort Key1:=wshN.Range("C1"), Header:=xlYes

  wshN.Range("E1") = "Match #"
  wshN.Range("F1") = "Match $"

  r = 2
  Do While Not (wshN.Cells(r, 1) = "" And wshN.Cells(r, 3) = "")
    If Not wshN.Cells(r, 1) = "" And wshN.Cells(r, 1) < wshN.Cells(r, 3) Then
      wshN.Cells(r, 3).Resize(1, 2).Insert Shift:=xlShiftDown
    ElseIf wshN.Cells(r, 1) > wshN.Cells(r, 3) And Not wshN.Cells(r, 3) = "" Then
      wshN.Cells(r, 1).Resize(1, 2).Insert Shift:=xlShiftDown
    End If
    If wshN.Cells(r, 1) = "" Then
      wshN.Cells(r, 3).Resize(1, 2).Interior.ColorIndex = intColor
    ElseIf wshN.Cells(r, 3) = "" Then
      wshN.Cells(r, 1).Resize(1, 2).Interior.ColorIndex = intColor
    End If
    r = r + 1
  Loop

  wshN.Range("E2:F" & (r - 1)).FormulaR1C1 = "=RC[-2]-RC[-4]"
  Application.ScreenUpdating = True
End Sub

[gvanhook]

Hans,
Thanks for the code. It did exactly what I needed. This will get used many times in the years to come. I took a look at the code and actualy understood it this time. I will be able to adapt this to several other uses.

I appreciate all the help you have given me over the years at WOPR.com and I am glad to have found your new location.

Greg

[HansV]

I'm glad it worked, and happy that you understood the code.