Compare two excel file vba

Question

Looking for a VBA code where I can compare data from two different excel files and add output in the third excel File.

File can contains N number of columns and N number of rows it has to validate.

1. I got a code to compare 2 sheets but I need output like below. (this vba code will open the excel file to read data) Output of data after comparing

Sub Compare()

Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range

Set objWorkbook1 = Workbooks.Open("F:LearningBook1.xlsx")
Set objWorkbook2 = Workbooks.Open("F:LearningBook2.xlsx")

Set objWorksheet1 = objWorkbook1.Worksheets(1)
Set objWorksheet2 = objWorkbook2.Worksheets(1)


Set WorkRng1 = objWorksheet1.UsedRange
Set WorkRng2 = objWorksheet2.UsedRange

For Each Rng1 In WorkRng1
    Rng1.Value = Rng1.Value
    For Each Rng2 In WorkRng2
        If Rng1.Value = Rng2.Value Then
            
            

            Exit For
        End If
    Next
Next


End Sub

Output requried like this

Name_Book1    | Name_Book2 |  Compare |   Amount_book1 |  Amount_book2|   Compare 
Store_1       | Store_1    | Pass     | 362            | 420           | Fail
Store_2       | Store_2    | Pass     | 400            | 360           |Fail
Store_3       | Store_3    | Pass     | 922            | 520           | Fail
Store_4       | Store_4    | Pass     | 600            | 320           | Fail
Store_5       | Store_5    | Pass     | 400            | 400           | Pass

2. Other code doesn't open the file but i need to compare data and get the output like above.

Excel File 1 | Excel File 2 | Output file

Sub GetDataFromSingleCell(cell As String)

Dim srcCN As Object ' ADODB.Connection
Dim srcRS As Object ' ADODB.Recordset

Set srcCN = CreateObject("ADODB.Connection")
Set srcRS = CreateObject("ADODB.Recordset")

srcCN.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & CStr("F:LearningBook1.xlsx") & _
            ";" & "Extended Properties=""Excel 12.0;HDR=No;"";"

srcRS.Open "SELECT * FROM [Sheet1$" & cell & ":" & cell & "];", srcCN, 3, 1  'adOpenStatic, adLockReadOnly

srctxt = srcRS.Fields(0).Value

Dim trgCN As Object ' ADODB.Connection
Dim trgRS As Object ' ADODB.Recordset

Set trgCN = CreateObject("ADODB.Connection")
Set trgRS = CreateObject("ADODB.Recordset")

trgCN.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & CStr("F:LearningBook2.xlsx") & _
            ";" & "Extended Properties=""Excel 12.0;HDR=No;"";"

trgRS.Open "SELECT * FROM [Sheet1$" & cell & ":" & cell & "];", trgCN, 3, 1  'adOpenStatic, adLockReadOnly

trgtxt = trgRS.Fields(0).Value

If srctxt = trgtxt Then
    Sheet1.Cells(1, 2) = "Passed"
Else
    Sheet1.Cells(1, 2) = "Failed"
End If

End Sub

Output file contains VBA code for references use.

Maybe reading a txt file same as excel file like above will be good.

question from:https://stackoverflow.com/questions/65851225/compare-two-excel-file-vba

Answer 1

Try this.

You will need a sheet named "Compare" in the workbook where the code is running.

Sub Compare()

    Dim Rng1 As Range, Rng2 As Range, arr1, arr2, arrOut
    Dim rw As Long, col As Long, c As Long, v1, v2
    
    'open workbooks and assign ranges  
    Set Rng1 = Workbooks.Open("F:LearningBook1.xlsx").Worksheets(1).UsedRange
    Set Rng2 = Workbooks.Open("F:LearningBook2.xlsx").Worksheets(1).UsedRange
   
    'check ranges are comparable 
    If Rng1.Rows.Count <> Rng2.Rows.Count Or _
       Rng1.Columns.Count <> Rng2.Columns.Count Then
        MsgBox "Ranges are different sizes!"
        Exit Sub
    End If
    
    'faster to read from arrays...
    arr1 = Rng1.Value
    arr2 = Rng2.Value
    'size array for output (need 3 output columns per input column)
    ReDim arrOut(1 To UBound(arr1, 1), 1 To 3 * UBound(arr1, 2))
    
    For rw = 1 To UBound(arr1, 1)
        c = 1 'start column position in output array
        For col = 1 To UBound(arr1, 2)
            v1 = arr1(rw, col)
            v2 = arr2(rw, col)
            If rw = 1 Then
                'column headers here...
                arrOut(rw, c) = v1 & "_book1"
                arrOut(rw, c + 1) = v2 & "_book2"
                arrOut(rw, c + 2) = "Compare"
            Else
                'column values comparison
                arrOut(rw, c) = v1
                arrOut(rw, c + 1) = v2
                arrOut(rw, c + 2) = IIf(v1 = v2, "Pass", "Fail")
            End If
            c = c + 3
        Next col
    Next rw
    
    'put result array on worksheet
    With ThisWorkbook.Sheets("Compare")
        .UsedRange.ClearContents
        .Range("A1").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
    End With
    
End Sub