Search code examples
excelvbadatabasems-access-2010

I want to compare two Excel files and highlight the differences with VBA


I need help about this particular code. I compared two Excel workbooks and I want to highlight the differences.. but I'm stuck here in this line which gives me an error:

iRow_M = s1.UsedRange.Rows.Count

here is the all code:

Option Explicit
Sub Compare_Two_Excel_Sheets()
    'Define Fields
    Dim Flag As Double
  
    Dim iR As Double, iC As Double, oRw As Double
    Dim iRow_M As Double, iCol_M As Double
    Dim s1 As Workbook, s2 As Workbook
    Dim s3 As Workbook
    
    Flag = 0
    Set s1 = Workbooks.Open(Filename:="C:\new\File1_Path.xlsx")
    Set s2 = Workbooks.Open(Filename:="C:\new\File2_Path.xlsx")
    'Set s3 = Workbook.Sheets(3)
    
    
    iRow_M = s1.UsedRange.Rows.Count
    iCol_M = s1.UsedRange.Columns.Count
    
    For iR = 1 To iRow_M
    For iC = 1 To iCol_M
        s1.Cells(iR, iC).Interior.Color = xlNone
        s2.Cells(iR, iC).Interior.Color = xlNone
        
        If s1.Cells(iR, iC) <> s2.Cells(iR, iC) Then
           s1.Cells(iR, iC).Interior.Color = vbYellow
           s2.Cells(iR, iC).Interior.Color = vbYellow
           
           oRw = oRw + 1
           s3.Cells(oRw, 1) = s1.Cells(iR, iC)
           s3.Cells(oRw, 2) = s2.Cells(iR, iC)
         
          Flag = Flag + 1
         
        End If
        
    Next iC
    Next iR
    
    If Flag > 0 Then
        VBA.Interaction.MsgBox "Differences exist, please check the sheet: DIFF!"
        Else: VBA.Interaction.MsgBox "No differences found!"
    
  End If

End Sub

I want to find differences between these two Excel files: File1_Path.xlsx and File2_Path.xlsx


Solution

  • Workbook doesn't have UsedRange property but WorkSheet has. It should be:

    iRow_M = s1.ActiveSheet.UsedRange.Rows.Count
    iCol_M = s1.ActiveSheet.UsedRange.Columns.Count
    

    Same goes with Cells as well. Instead of s1 and s2 you should use s1.ActiveSheet and s2.ActiveSheet.

    Option Explicit
    Sub Compare_Two_Excel_Sheets()
        'Define Fields
        Dim Flag As Double
      
        Dim iR As Double, iC As Double, oRw As Double
        Dim iRow_M As Double, iCol_M As Double
        Dim s1 As Workbook, s2 As Workbook
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim s3 As Workbook
        
        Flag = 0
        Set s1 = Workbooks.Open(Filename:="C:\new\File1_Path.xlsx")
        Set s2 = Workbooks.Open(Filename:="C:\new\File2_Path.xlsx")
        'Set s3 = Workbook.Sheets(3)
        Set ws1 = s1.ActiveSheet
        Set ws2 = s2.ActiveSheet
        
        iRow_M = ws1.UsedRange.Rows.Count
        iCol_M = ws1.UsedRange.Columns.Count
        
        For iR = 1 To iRow_M
        For iC = 1 To iCol_M
            ws1.Cells(iR, iC).Interior.Color = xlNone
            ws2.Cells(iR, iC).Interior.Color = xlNone
            
            If ws1.Cells(iR, iC) <> ws2.Cells(iR, iC) Then
               ws1.Cells(iR, iC).Interior.Color = vbYellow
               ws2.Cells(iR, iC).Interior.Color = vbYellow
               
               oRw = oRw + 1
               's3.Cells(oRw, 1) = s1.Cells(iR, iC)
               's3.Cells(oRw, 2) = s2.Cells(iR, iC)
             
              Flag = Flag + 1
             
            End If
            
        Next iC
        Next iR
        
        If Flag > 0 Then
            VBA.Interaction.MsgBox "Differences exist, please check the sheet: DIFF!"
            Else: VBA.Interaction.MsgBox "No differences found!"
        
      End If
    
    End Sub