VBA code compare two identical excel report and generate difference report

[Satyarthas]

Hi,

Can any one help e out, i am trying to create Macro file which can compare two identical excel reports (Workbook) and generate difference report with same layout and formatting.

Thanks
Satyartha

 

[igold]

If they are identical, how different can they be...

 

[Satyarthas]

tables and formatting of the file are identical but the report is generated every day, so for instance if i have to compare difference of last week report with today's report. i have already created the macro but i am not able to align the data in tabular format.

[TABLE="width: 460"]
<colgroup><col><col span="3"><col span="3"></colgroup><tbody>[TR]
[TD] [TABLE="width: 460"]
<colgroup><col><col span="3"><col span="3"></colgroup><tbody>[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Last week[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Range[/TD]
[TD]18Q2[/TD]
[TD]18Q3[/TD]
[TD]18Q4[/TD]
[TD]19Q1[/TD]
[TD]QTD[/TD]
[TD]YoY[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$0.1[/TD]
[TD]$0.0[/TD]
[TD]$4.6[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]CDF[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$3.4[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]GHI[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$2.7[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]JKL[/TD]
[TD]$0.1[/TD]
[TD]$0.6[/TD]
[TD]$0.7[/TD]
[TD]$0.5[/TD]
[TD]$0.9[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]MNO[/TD]
[TD]$0.9[/TD]
[TD]$0.3[/TD]
[TD]$1.4[/TD]
[TD]$0.3[/TD]
[TD]$1.5[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]PQR[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$0.0[/TD]
[TD]$4.2[/TD]
[TD]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]




[TABLE="width: 460"]
<colgroup><col><col span="3"><col span="3"></colgroup><tbody>[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]This week[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Range[/TD]
[TD]18Q2[/TD]
[TD]18Q3[/TD]
[TD]18Q4[/TD]
[TD]19Q1[/TD]
[TD]QTD[/TD]
[TD]YoY[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]$0.0[/TD]
[TD]$0.1[/TD]
[TD]$0.0[/TD]
[TD]$0.6[/TD]
[TD]$9.8[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]CDF[/TD]
[TD]$0.1[/TD]
[TD]$0.1[/TD]
[TD]$0.2[/TD]
[TD]$1.0[/TD]
[TD]$14.0[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]GHI[/TD]
[TD]$0.2[/TD]
[TD]$0.2[/TD]
[TD]$0.2[/TD]
[TD]$1.7[/TD]
[TD]$19.8[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]JKL[/TD]
[TD]$1.9[/TD]
[TD]$2.3[/TD]
[TD]$2.3[/TD]
[TD]$3.4[/TD]
[TD]$8.2[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]MNO[/TD]
[TD]$2.2[/TD]
[TD]$0.1[/TD]
[TD]$1.0[/TD]
[TD]$1.1[/TD]
[TD]$18.3[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]PQR[/TD]
[TD]$0.7[/TD]
[TD]$0.0[/TD]
[TD]$1.4[/TD]
[TD]$2.5[/TD]
[TD]$23.7[/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]

 

[igold]

This is what we needed to see. Why don't you post your macro, so that we can see how far along you are and perhaps just add on to it or alter it to help you.

Are they really tables or are they ranges of data.

 

[Satyarthas]

Please find the code below,

Sub Compare_WB_test()
Dim sh As Integer, ShName As String, C_Idx As Long, D_Idx As Long, ssh As String
Dim WB_1 As Workbook, WB_2 As Workbook, statmsg As String, limitcnt As Long
Dim idxRow As Double, idxCol As Double, idxRow_Cnt As Double, idxCol_Cnt As Double
Dim File_1 As String, File_2 As String, WB1_Data As Variant, WB2_Data As Variant


'Assign the Workbook
File_1 = ThisWorkbook.Sheets("Home").Cells(2, 2)
File_2 = ThisWorkbook.Sheets("Home").Cells(3, 2)
idxRow_Cnt = ThisWorkbook.Sheets("Home").Cells(4, 2)
idxCol_Cnt = ThisWorkbook.Sheets("Home").Cells(5, 2)
C_Idx = ThisWorkbook.Sheets("Home").Cells(6, 2).Interior.ColorIndex


'Open Files
Set WB_2 = Workbooks.Open(File_2)
Set WB_1 = Workbooks.Open(File_1)
ThisWorkbook.Sheets("Home").Cells(7, 2) = "Number of Sheets Found# " & WB_1.Sheets.Count


'Read Data
D_Idx = 1
limitcnt = 1
ThisWorkbook.Sheets("Comparison report").Cells.Clear
ThisWorkbook.Sheets("Comparison report").Cells(D_Idx, 2) = WB_1.Name
ThisWorkbook.Sheets("Comparison report").Cells(D_Idx, 3) = WB_2.Name
ThisWorkbook.Sheets("Comparison report").Activate
statmsg = Application.StatusBar
For sh = 1 To WB_1.Sheets.Count
ShName = WB_1.Sheets(sh).Name
ThisWorkbook.Sheets("Home").Cells(7 + sh, 1) = ShName
ThisWorkbook.Sheets("Home").Cells(7 + sh, 2) = "Identical"
ThisWorkbook.Sheets("Home").Cells(7 + sh, 2).Interior.Color = vbGreen
Application.StatusBar = statmsg & " ,Processing: " & ssh


If ThisWorkbook.Sheets("Home").Cells(4, 2) = 0 Then idxRow_Cnt = WB_1.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Row
If ThisWorkbook.Sheets("Home").Cells(5, 2) = 0 Then idxCol_Cnt = WB_1.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Column
For idxRow = 1 To idxRow_Cnt
For idxCol = 1 To idxCol_Cnt
WB1_Data = WB_1.Sheets(ShName).Cells(idxRow, idxCol)
WB2_Data = WB_2.Sheets(ShName).Cells(idxRow, idxCol)


'Compare Data
If WB1_Data <> WB2_Data Then
WB_1.Sheets(ShName).Cells(idxRow, idxCol).Interior.ColorIndex = C_Idx
ThisWorkbook.Sheets("Home").Cells(7 + sh, 2) = "Mismatch Found"
ThisWorkbook.Sheets("Home").Cells(7 + sh, 2).Interior.ColorIndex = C_Idx
If ssh <> WB_1.Sheets(sh).Name Then
D_Idx = D_Idx + 1
ThisWorkbook.Sheets("Comparison report").Cells(D_Idx, 2) = WB_1.Sheets(sh).Name
ThisWorkbook.Sheets("Comparison report").Cells(D_Idx, 3) = WB_2.Sheets(sh).Name
ssh = WB_1.Sheets(sh).Name
End If
D_Idx = D_Idx + 1


ThisWorkbook.Sheets("Comparison report").Cells(D_Idx, 1) = WB_1.Sheets(ShName).Cells(idxRow, idxCol).Address
ThisWorkbook.Sheets("Comparison report").Cells(D_Idx, 2) = WB1_Data
ThisWorkbook.Sheets("Comparison report").Cells(D_Idx, 3) = WB2_Data
ThisWorkbook.Sheets("Comparison report").Cells(D_Idx, 2).Select
End If


Next idxCol
Next idxRow
ThisWorkbook.Sheets("Home").Cells(7 + sh, 2) = ThisWorkbook.Sheets("Home").Cells(7 + sh, 2) & " (" & idxRow_Cnt & "-Rows , " & idxCol_Cnt & "-Cols Compared)"
Next sh


Limit_Exit:
End Sub

 

[igold]

Given your stated requirements and looking strictly at the sample data you gave in Post #3 , what I did was take your "Last Week" data and pasted that into a sheet named "Home". I took your "This Week" data and pasted that into a sheet called "Comparison Report". Both of these pastes start in cell A1 with the header "Range" in that cell. I then took the "Last Week" data and subtracted the values from the "This Week" data (it seemed logical). I created a data range with those results and pasted that into "Sheet3" and copied the formatting.

Unfortunately I could not relate to your code as I do not know where the data actually is on the specified sheets.

Sub test()


    Dim rng1 As Range, rng2 As Range
    Dim arr1, arr2, arr3
    Dim i As Long, x As Long
    
    Set rng1 = Sheets("Home").UsedRange
    Set rng2 = Sheets("Comparison Report").UsedRange
    arr1 = rng1
    arr2 = rng2
    arr3 = arr1
        For i = 2 To UBound(arr1)
            For x = 2 To UBound(arr1, 2)
                arr3(i, x) = arr2(i, x) - arr1(i, x)
            Next
        Next
    With Worksheets("Sheet3")
        .Range("A1").Resize(UBound(arr3, 1), UBound(arr3, 2)) = arr3
        rng1.Copy
        .Range("A1").PasteSpecial xlPasteFormats
        .Select
        Range("A1").Select
    End With
    Application.CutCopyMode = False
    
End Sub