VBA code compare two identical excel report and generate difference report

Satyarthas

New Member
Joined
Jul 17, 2018
Messages
3
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
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
If they are identical, how different can they be...
 
Upvote 0
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.

Last week
Range18Q218Q318Q419Q1QTDYoY
ABC$0.0$0.0$0.1$0.0$4.6
CDF$0.0$0.0$0.0$0.0$3.4
GHI$0.0$0.0$0.0$0.0$2.7
JKL$0.1$0.6$0.7$0.5$0.9
MNO$0.9$0.3$1.4$0.3$1.5
PQR$0.0$0.0$0.0$0.0$4.2

<colgroup><col><col span="3"><col span="3"></colgroup><tbody>
</tbody>

<colgroup><col><col span="3"><col span="3"></colgroup><tbody>
</tbody>




This week
Range18Q218Q318Q419Q1QTDYoY
ABC$0.0$0.1$0.0$0.6$9.8
CDF$0.1$0.1$0.2$1.0$14.0
GHI$0.2$0.2$0.2$1.7$19.8
JKL$1.9$2.3$2.3$3.4$8.2
MNO$2.2$0.1$1.0$1.1$18.3
PQR$0.7$0.0$1.4$2.5$23.7

<colgroup><col><col span="3"><col span="3"></colgroup><tbody>
</tbody>
 
Upvote 0
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.
 
Last edited:
Upvote 0
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
 
Upvote 0
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.

Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,501
Messages
6,114,010
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top