VBA - Compare Column on Previous Report With New Report to Find New Entries

Question

I have 4 sheets in total that need to be used.

• ServerList1
• ServerList2
• MachineList1
• MachineList2

The sheet names with a (1) next to them are the reports from last week and the sheet names with a (2) next to them are the reports from this week.

In each sheet, there are multiple columns which I get rid of so that all that remains is the column with either the Server Name or the Machine Name

Essentially, I need to compare last weeks report with this weeks report and see what new servers have been added (if any) and what new machines have been added (if any).

Conversely, I need to do the opposite, check what servers have been removed (if any) and what machines have been removed (if any)..

With the below code, it should be simple to accomplish the second part simply by switching the worksheet names..

I found the below code here:

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/145223-compare-2-columns-in-different-sheets-and-copy-entire-rows-into-new-sheets

This code does a comparison and copies the new appearances, but there's two issues I am currently experiencing:

1) The code looks like it gets stuck in an infinite loop - I need to exit the code manually

2) On the New Servers-Machines sheet, the results are pasted from row A2 instead of A1

Sub compareSheets()

    ThisWorkbook.RefreshAll
    Dim rng As Range, c As Range, cfind As Range

    Dim ws1 As Worksheet

    Set ws1 = Worksheets("New Servers-Machines")

    On Error Resume Next

    With Worksheets("Last Week Servers")

        Set rng = .Range(.Range("A1"), .Range("c1").End(xlDown))

        For Each c In rng
            c = Replace(c, " ", "")

            With Worksheets("This Week Servers")
                Set cfind = .Columns("A:A").Cells.Find(what:=c.Value, lookat:=xlWhole)

                If cfind Is Nothing Then
                    c.Resize(1, 1).EntireRow.Copy
                    ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            End With
        Next c

        Application.CutCopyMode = False

    End With

    With Worksheets("This Week Servers")

        Set rng = .Range(.Range("A1"), .Range("c1").End(xlDown))

        For Each c In rng
            c = Replace(c, " ", "")

            With Worksheets("Last Week Servers")
                Set cfind = .Columns("A:A").Cells.Find(what:=c.Value, lookat:=xlWhole)

                If cfind Is Nothing Then
                    c.Resize(1, 1).EntireRow.Copy
                    ws1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            End With
        Next c

        Application.CutCopyMode = False

    End With

End Sub

UPDATE:

Public Sub FindDifferences1()

    Dim firstRange As Range
    Dim secondRange As Range
    Dim myCell As Range

    Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet

    'Find Removed Wintel Servers
    Set wks1 = ActiveWorkbook.Sheets("Last Week Servers List")
    Set wks2 = ActiveWorkbook.Sheets("This Week Servers List")
    Set wks3 = ActiveWorkbook.Sheets("New Servers")

    Set firstRange = wks1.Range("A:A")
    Set secondRange = wks2.Range("A:A")

    For Each myCell In firstRange
        If myCell <> secondRange.Range(myCell.Address) Then

            myCell.Copy

            wks3.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            wks3.Cells(Rows.Count, 2).End(xlUp).PasteSpecial xlPasteFormats

        End If
    Next myCell

End Sub

Format of the sheets is only one column with a row header Server Name

Answer 1

Let's assume that you have 3 worksheets:

• worksheet1 - to compare with worksheet2
• worksheet2 - to compare with worksheet1
• worksheet3 - to write the values, which are different in worksheet1

Then some simple code as this one works quite ok:

Public Sub FindDifferences()

    Dim firstRange As Range
    Dim secondRange As Range

    Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
    Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
    Dim wks3 As Worksheet: Set wks3 = Worksheets(3)

    Set firstRange = wks1.UsedRange
    Set secondRange = wks2.UsedRange

    Dim myCell  As Range

    For Each myCell In firstRange
        If myCell <> secondRange.Range(myCell.Address) Then
            wks3.Range(myCell.Address) = myCell
        End If
    Next myCell

End Sub

What does it do?

• if loops through every cell of the UsedRange in Worksheets(1) and it compares it with the same cell in Worksheets(2);
• if the comparison is different, then it writes the cell from Worksheets(1) in Worksheets(3);
• you may consider coloring the cell in Worksheets(1), if different as well;

---

If your columns are on different places, thus you would like to compare column B with column D, then a bit crunching of the ranges is needed:

Set firstRange = wks1.UsedRange.Columns(2).Cells
Set secondRange = wks1.UsedRange.Columns(4).Cells

For Each myCell In firstRange
    If myCell.Value2 <> secondRange.Cells(myCell.Row, secondRange.Column).Value2 Then
        wks3.Range(myCell.Address) = myCell.Value2
    End If
Next myCell