Compare data between 2 workbooks

[dvitale71]

Hi,
I'm trying to compare and list add/deletes between column A in Current Workbook vs. Previous Workbook. I was able to locate some code and modified it and is working well but not exactly what I want.

• The code below does compare both sheets and and produces a match vs. mismatch message box
• I want to identify what's new (added) between Current Workbook vs. Previous Workbook
• I want to identify what's old (removed) between Current Workbook vs. Previous Workbook
• I want to insert above findings into a new tab on Current Workbook where Column A is adds and Column B is deletes

Sub WorkbookComparision()
    Dim i As Long
    Dim wb1ws1, wb2ws2
    Dim blnSame As Boolean
    
    wb1ws1 = Workbooks("Current.xlsx").Worksheets("MASTER").Range("A4:A2500").Value
    wb2ws2 = Workbooks("Previous.xlsx").Worksheets("MASTER").Range("A4:A2500").Value
    
    For i = LBound(wb1ws1) To UBound(wb1ws1)
        If wb1ws1(i, 1) = wb2ws2(i, 1) Then
            blnSame = True
        Else
            blnSame = False
            Exit For
        End If
    Next i
    
    If blnSame = True Then
        MsgBox "data is the same"
    Else
        MsgBox "data is different"
    End If
End Sub

Any help or guidance is appreciated.

Thank you.

 

[Fluff]

Untested, but try

Sub WorkbookComparision()
   Dim wb1ws1, wb2ws2
   Dim Dic2 As Object
   Dim Wb1 As Workbook
   
   Set Dic2 = CreateObject("scripting.dictionary")
   Set Wb1 = Workbooks("Current.xlsx")
   wb1ws1 = Wb1.Worksheets("MASTER").Range("A4:A2500").Value
   wb2ws2 = Workbooks("Previous.xlsx").Worksheets("MASTER").Range("A4:A2500").Value
   
   With CreateObject("scripting.dictionary")
      For i = LBound(wb1ws1) To UBound(wb1ws1)
         If Not .exists(wb1ws1(i, 1)) Then .Add wb1ws1(i, 1), Nothing
      Next i
      For i = LBound(wb2ws2) To UBound(wb2ws2)
         If .exists(wb2ws2(i, 1)) Then
            .Remove wb2ws2(i, 1)
         ElseIf Not Dic2.exists(wb2ws2(i, 1)) Then
            Dic2.Add wb2ws2(i, 1), Nothing
         End If
      Next i
      Wb1.Sheets.Add(, Wb1.Sheets(Wb1.Sheets.Count)).Name = "Results"
      Wb1.Sheets("results").Range("A1").Resize(.Count).Value = Application.Transpose(.keys)
      Wb1.Sheets("results").Range("B1").Resize(Dic2.Count).Value = Application.Transpose(Dic2.keys)
   End With
End Sub

 

[dvitale71]

This code worked great, however, are we able to add something if no changes occur between the two files. For example, if there are no changes can we make A1 state... "There are no changes reported this week". Currently, this scenario errors out.

Untested, but try

Sub WorkbookComparision()
   Dim wb1ws1, wb2ws2
   Dim Dic2 As Object
   Dim Wb1 As Workbook
   
   Set Dic2 = CreateObject("scripting.dictionary")
   Set Wb1 = Workbooks("Current.xlsx")
   wb1ws1 = Wb1.Worksheets("MASTER").Range("A4:A2500").Value
   wb2ws2 = Workbooks("Previous.xlsx").Worksheets("MASTER").Range("A4:A2500").Value
   
   With CreateObject("scripting.dictionary")
      For i = LBound(wb1ws1) To UBound(wb1ws1)
         If Not .exists(wb1ws1(i, 1)) Then .Add wb1ws1(i, 1), Nothing
      Next i
      For i = LBound(wb2ws2) To UBound(wb2ws2)
         If .exists(wb2ws2(i, 1)) Then
            .Remove wb2ws2(i, 1)
         ElseIf Not Dic2.exists(wb2ws2(i, 1)) Then
            Dic2.Add wb2ws2(i, 1), Nothing
         End If
      Next i
      Wb1.Sheets.Add(, Wb1.Sheets(Wb1.Sheets.Count)).Name = "Results"
      Wb1.Sheets("results").Range("A1").Resize(.Count).Value = Application.Transpose(.keys)
      Wb1.Sheets("results").Range("B1").Resize(Dic2.Count).Value = Application.Transpose(Dic2.keys)
   End With
End Sub

 

[Fluff]

How about

      Wb1.Sheets.Add(, Wb1.Sheets(Wb1.Sheets.Count)).Name = "Results"
      If .Count > 0 Then
         Wb1.Sheets("results").Range("A1").Resize(.Count).Value = Application.Transpose(.keys)
      Else
         Wb1.Sheets("results").Range("A1").Value = "There are no changes reported this week"
      End If
      If Dic2.Count > 0 Then
         Wb1.Sheets("results").Range("B1").Resize(Dic2.Count).Value = Application.Transpose(Dic2.keys)
      Else
          Wb1.Sheets("results").Range("B1").Value = "There are no changes reported this week"
      End If

 

[dvitale71]

This worked out great. Thanks so much!

 

[Fluff]

Glad to help & thanks for the feedback