VBA Compare Sheets

Embarrassed Eel answered on October 30, 2022 Popularity 3/10 Helpfulness 1/10

answer VBA Compare Sheets

VBA Compare Sheets

Comment

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

Popularity 3/10 Helpfulness 1/10 Language vb

Source: vbaa2z.blogspot.com

Tags: compare vba

Link to this answer
Share Copy Link

Contributed on Oct 30 2022

Embarrassed Eel

0 Answers Avg Quality 2/10

VBA Compare Sheets

Contents

More Related Answers

VBA Compare Sheets

Grepper

Documentation

Social

Legal

Contact

Oops, You will need to install Grepper and log-in to perform this action.