Display differences between two Excel 2007 worksheets 1

[BxWill]

Need some timely insight.

Using the code below, I am able to highlight differences between two worksheets within the same MS Excel 2007 workbook.

The differences are displayed in a separate workbook.

What modifications are needed so that the following will occurr?;

1. The differences are highlighted by row numbers and column headings on a worksheet within the same workbook instead of a separate workbook.

2. Also, if I am comparing a "CurrentData" file (file extracted today) with a "PreviousData" file (file extracted last week), is it possible to overlay the data in the previous file if the data has been modified? For example, both files have the same column headings including a column heading titled "AccountNumber." So, I would like to overlay all other columns for the records with the same account number if the data changed.

Thanks in advance.

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
    Application.ScreenUpdating = False
    Application.StatusBar = "Creating the report..."
    Set rptWB = Workbooks.Add
    Application.DisplayAlerts = False
    'While rptWB.Worksheets.Count > 1
    '    rptWB .Worksheets(2).Delete
    'Wend
  
    
    Application.DisplayAlerts = True
    With ws1.UsedRange
        lr1 = .Rows.Count
        lc1 = .Columns.Count
    End With
    With ws2.UsedRange
        lr2 = .Rows.Count
        lc2 = .Columns.Count
    End With
    maxR = lr1
    maxC = lc1
    If maxR < lr2 Then maxR = lr2
    If maxC < lc2 Then maxC = lc2
    DiffCount = 0
    For c = 1 To maxC
        Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
        For r = 1 To maxR
            cf1 = ""
            cf2 = ""
            On Error Resume Next
            cf1 = ws1.Cells(r, c).FormulaLocal
            cf2 = ws2.Cells(r, c).FormulaLocal
            On Error GoTo 0
            If cf1 <> cf2 Then
                DiffCount = DiffCount + 1
                Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
            End If
        Next r
    Next c
    Application.StatusBar = "Formatting the report..."
    With Range(Cells(1, 1), Cells(maxR, maxC))
        .Interior.ColorIndex = 19
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error Resume Next
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error GoTo 0
    End With
    Columns("A:IV").ColumnWidth = 20
    rptWB.Saved = True
    If DiffCount = 0 Then
        rptWB.Close False
    End If
    Set rptWB = Nothing
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
        "Compare " & ws1.Name & " with " & ws2.Name
End Sub

Sub TestCompareWorksheets()
    ' compare two different worksheets in the active workbook
    CompareWorksheets Worksheets("CurrentData"), Worksheets("PreviousData")
    ' compare two different worksheets in two different workbooks
    'CompareWorksheets ActiveWorkbook.Worksheets("CurrentData"), _
    '    Workbooks("WorkBookName.xls").Worksheets("PreviousData")
End Sub

 

[SkipVought]

hi,

Please post VBA questions in forum707.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

1. add a worksheet rather than a workbook to highlight differences. Reference that sheet object when you record the differences. Your current code ASSUMES the active sheet (not good!)

2. in addition to recording the difference, add a statement to assign to the cells(row,col) in ws2 the cf1 value.

ws2.Cells(r, c).Formula = cf1

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[BxWill]

Not quite able to resolve due to lack of proficiency with vba.


Any additional insight?