2

Similar issue to these:

Find the differences between 2 Excel worksheets?

Compare two excel sheets

My issue specifically, I have a monthly employee listing with a unique ID and around 30 columns of other data for around 900 employees.

I'm trying to accomplish two things:

  1. Compare if employees were added or dropped between the lists.
  2. Between the sheets for each employee compare what other data for that employee changed. i.e. Job Title changed.

Most compare add-ins/modules I find only compare the specific ranges in order, thus once once difference if found every subsequent row will be different.

First, I'm wondering if there are any existing tools that can do this. If not I was thinking of building my own. I was thinking of doing this by looping through each employee and using vlookup to verify matches. I'm concerned doing this many loops will make the macro difficult to use. Any guidance on how I should go about this? Thanks.

Community
  • 1
  • 1
kwilmarth
  • 43
  • 2
  • 7

2 Answers2

1

Untested, but will give you a place to start from... This does not find ex-employees which are on the "old" sheet but not on the "current" sheet.

Sub CompareEmployeeInfo()

    Const ID_COL As Integer = 1 ' ID is in the first column
    Const NUM_COLS As Integer = 30 'how many columns are being compared?

    Dim shtNew As Excel.Worksheet, shtOld As Excel.Worksheet
    Dim rwNew As Range, rwOld As Range, f As Range
    Dim x As Integer, Id
    Dim valOld, valNew

    Set shtNew = ActiveWorkbook.Sheets("Employees")
    Set shtOld = ActiveWorkbook.Sheets("Employees")

    Set rwNew = shtNew.Rows(2) 'first employee on "current" sheet

    Do While rwNew.Cells(ID_COL).Value <> ""

        Id = rwNew.Cells(ID_COL).Value
        Set f = shtOld.UsedRange.Columns(ID_COL).Find(Id, , xlValues, xlWhole)
        If Not f Is Nothing Then
            Set rwOld = f.EntireRow

            For x = 1 To NUM_COLS
                If rwNew.Cells(x).Value <> rwOld.Cells(x).Value Then
                    rwNew.Cells.Interior.Color = vbYellow
                Else
                    rwNew.Cells.Interior.ColorIndex = xlNone                    
                End If
            Next x

        Else
            rwNew.Cells(ID_COL).Interior.Color = vbGreen 'new employee
        End If

        Set rwNew = rwNew.Offset(1, 0) 'next row to compare
    Loop

End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
0

Don't know if there is anything that does that for you or not. But, you can use the Dictionary Object to make this comparison task much easier. You can also take examples from this answer that uses Dictionaries which checked for uniques and is optimized for speed, change it to what you need. Then you can use this fast method to color the cells or whatever you want to do with it.

I know I'm not providing code for you but these pointers will get you started, and if you have more questions I can help you out.

Community
  • 1
  • 1
Jon49
  • 4,444
  • 4
  • 36
  • 73