Compare Two Excel 2007 Worksheets - store differences on 3rd Wrksheet 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.

Bottomline, the objective is to "mirror" the data entry into a MS Access database table that are made daily by another individual.

Is there a more effective method to accomplish the objective?


Thanks in advance.


CODE
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

 

[BxWill]

Did make the following changes but at a loss as to proceed further.


Dim rptWS As Worksheet, DiffCount As Long

Set rptWS = Worksheets.Add

Maybe, I need to explain what I am trying to accomplish;

Using Excel 2007, I have 5 worksheets.

CurrentData
PreviousData
QueryResults1
QueryResults2
QueryResults3

CurrentData contains the results of a MS Query extraction of a table within the MS Access Database

PreviousData contains the same columns in "CurrentData" and additional columns including calculated columns

QueryResults1, QueryResults2, and QueryResults3 are query results from sql server queries that I have copied/pasted

I am interested in "mirroring" the contents of the table within the MS Access database that is being updated daily and having the changes "flow" to the worksheet titled "PreviousData" if there are changes to the data for the account numbers already on the worksheet and add the data along with the account numbers if they are not on the "PreviousData" worksheet.

Is this even possible/feasible?

Any insight as to if there is a more preferred method?

Thanks in advance.

 

[BxWill]

Maybe, I complicated this too much.

Initially, I requested any insight as to modification of the code provided so that all differences between two worksheets within the same workbook are displayed on a third worksheet within the same workbook.

The second request, using Excel to "mirror" the daily data entry/modification into a MS Access table may not be possible.

Is there anyone who is able to assist in resolving the first objective - displaying the differences between two worksheets on a third worksheet?

 

[SkipVought]

Hi,

   Dim rptWB As Workbook
'...
   Set rptWB = Workbooks.Add

I thot you want all this done in the same workbook???

   Dim rptWS As WorkSheet
'...
    Set rptWS = Thisworkbook.WorkSheets.Add
'...
            If cf1 <> cf2 Then
                DiffCount = DiffCount + 1
                rpt.WS.Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
                ws2.Cells(r, c).Formula = cf1

            End If

Skip,

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

 

[BxWill]

Decided to try to perform this in a different fashion due to not able to distinguish between variations in the columns with a lot of text.

I setup a worksheet ("CurrentData") that I use to extract the contents of the table within the remote MS Access database, using MS Query.

I refresh on a daily basis.

Finally, I compare with the data that I extracted on a prior day, and copy/paste in the most recent data to the "PreviousData" worksheet while ensuring that I am copying the data for the appropriate account number by using the filter.

Time consuming, but it works!

Thoughts?