VBA to Compare Multiple Sheets - Advanced & Super Fast

Hi everyone,

In this new series 'Plug & Play', we'll show you all cool VBA codes that you can use to automate your work and significantly improve your efficiency. All codes in these series are ready for use with little or no change at all.

No prerequisites: You do not need prior programming experience to use this however, you are expected to have a basic understanding of Excel.

If you have any questions/feedback/tutorial request, please feel to comment below or directly email us at vbaa2z.team@gmail.com and I will try and come back as soon as possible.

I do not actively monitor this blog so if you have any question please comment on the video link below. Tutorial Link:- https://youtu.be/tZUU_HdY1vU

Option Explicit

Sub test_CompareSheets_Adv()

ActiveWorkbook.Activate

If SheetExists("results") = False Then
    Sheets.Add
    ActiveSheet.Name = "results"
End If

If CompareSheets_Adv("Sheet3", "Sheet4") = True Then
    MsgBox " Completed Successfully!"
    Else
    MsgBox "Process Failed"
End If

End Sub
Function CompareSheets_Adv(sh1Name$, sheet2name$) As Boolean

Dim vstr As String
Dim vData As Variant
Dim vitm As Variant
Dim vArr As Variant
Dim v()

Dim a As Long
Dim b As Long
Dim c As Long

On Error GoTo CompareSheetsERR

vData = Sheets(sh1Name$).Range("A1:T6817").Value

With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        
        ReDim v(1 To UBound(vData, 2))
        
        For a = 2 To UBound(vData, 1)
            
            For b = 1 To UBound(vData, 2)
                vstr = vstr & Chr(2) & vData(a, b)
                v(b) = vData(a, b)
            Next
            
            .Item(vstr) = v
            vstr = ""
            
        Next
        
        vData = Sheets(sheet2name$).Range("A1:T6817").Value

        
        For a = 2 To UBound(vData, 1)
            
            For b = 1 To UBound(vData, 2)
                vstr = vstr & Chr(2) & vData(a, b)
                v(b) = vData(a, b)
            Next
        
            If .exists(vstr) Then
                .Item(vstr) = Empty
                Else
                .Item(vstr) = v
            End If
            
            vstr = ""
        Next
        
        For Each vitm In .keys
            If IsEmpty(.Item(vitm)) Then
            .Remove vitm
            End If
        Next
            
        vArr = .items
        c = .Count

End With

With Sheets("Results").Range("a1").Resize(, UBound(vData, 2))

    .Cells.Clear
    .Value = vData
    
    If c > 0 Then
        .Offset(1).Resize(c).Value = Application.Transpose(Application.Transpose(vArr))
    End If
    
End With

CompareSheets_Adv = True

Exit Function
CompareSheetsERR:
CompareSheets_Adv = False

End Function

Function SheetExists(shName As String) As Boolean
    With ActiveWorkbook
        On Error Resume Next
        SheetExists = (.Sheets(shName).Name = shName)
        On Error GoTo 0
    End With
    
End Function