Results 1 to 1 of 1

Thread: Compare .xlsx files for differences

  1. #1

    Compare .xlsx files for differences



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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
    Attached Files Attached Files

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •