Compare .xlsx files for differences

aadityapatel1984

New member
Joined
May 2, 2014
Messages
3
Reaction score
0
Points
0
I have written VBA code for compare two excel sheet and save the result in new workbook but i need output should be formatted nicely here is the link for generated excel sheet after comparison Compare_String.xlsx and here is the format of excel sheet what i want it should be after string compare Compare_String_1.xlsx


Link to two excel sheet for comparison
ws1.xlsm contained macro for comparison between ws1.xlsm and ws2.xlsx

Here is the VBA code contained in ws1.xlsm


Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)
Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
Dim report As Workbook, difference As Long
Dim row As Long, col As Integer
strNewWBName = "C:\ExcelFiles\Compare_String.xlsx"
Set report = Workbooks.Add
With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With
With ws2.UsedRange
ws2row = .Rows.Count
ws2col = .Columns.Count
End With
maxrow = ws1row
maxcol = ws1col
If maxrow < ws2row Then maxrow = ws2row
If maxcol < ws2col Then maxcol = ws2col
difference = 0
For col = 1 To maxcol
For row = 1 To maxrow
colval1 = ""
colval2 = ""
colval1 = ws1.Cells(row, col).Formula
colval2 = ws2.Cells(row, col).Formula
If colval1 <> colval2 Then
difference = difference + 1
Cells(row, col).Formula = ws2.Cells(row, col).Value
Cells(row, col).Interior.Color = 255
Cells(row, col).Font.ColorIndex = 2
Cells(row, col).Font.Bold = True
End If
Next row
Next col
Columns("A:B").ColumnWidth = 25
report.SaveAs strNewWBName
If difference = 0 Then
report.Close False
End If
Application.DisplayAlerts = True
ActiveSheet.Name = "Compare_String"
If report.Saved = False Then
report.Save
End If
report.Close
Set report = Nothing
End Sub


Sub foo()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("C:\ExcelFiles\ws1.xlsx")
Set y = Workbooks.Open("C:\ExcelFiles\Compare_String.xlsx")
x.Sheets("Sheet1").Range("A1:F1").Copy
y.Sheets("Compare_String").Range("A1:F1").PasteSpecial
Application.DisplayAlerts = False
x.Close
y.Save
y.Close
Application.DisplayAlerts = True
End Sub


Private Sub CommandButton1_Click()
Set myWorkbook1 = Workbooks.Open("C:\ExcelFiles\ws2.xlsx")
Compare2WorkSheets Workbooks("ws1.xlsm").Worksheets("Sheet1"), myWorkbook1.Worksheets("Sheet1")
Call foo
End Sub
Please help


Thanks
Aaditya
 

Attachments

  • ws1.xlsm
    27.7 KB · Views: 55
  • ws2.xlsx
    10.1 KB · Views: 41
  • Compare_String.xlsx
    9 KB · Views: 48
  • Compare_String_1.xlsx
    9.6 KB · Views: 49
Back
Top