Comparing Data & Marking Differences

[llldebaserll]

Hi,

I'm having one heck of a time figuring out where I've goofed up my coding.
I'm am importing data from an online database each morning and want to run a macro that will detect any changes from the day before (new worksheet each day).
If something has changed, I want to simply highlight the row so I can find it amongst the average 4000 entries.

The problem I am running into is that it doesn't seem to be finding/marking the correct rows. On my actual worksheet, it seemed to highlight EVERY row, even if something hadn't changed. And now, on the mock-up version I made to post here, it seems to be only highlighting the first 15 rows, then stopping. BUT the two worksheets are completely identical. I literally just copied one and renamed it.

I hope this makes sense. Here is the Sub I'm working with. (I'm sure it's a bit primitive, I'm rather new to vba)


Sub A_CompareAccounts3()
Dim OrigOffset As Integer
Dim InvNo As String
Dim Disp1 As String
Dim Disp2 As String
Dim ItemAmt As String
Dim ColorTag As Boolean
Dim ColorTag2 As Boolean
Dim Counter As Long
Dim PctDone As Single
Dim TotalRows As Long

' Progress Bar Set Up
Set ProgressIndicator = New UserForm1
ProgressIndicator.Show vbModeless
If TypeName(ActiveSheet) <> "Worksheet" Then
Unload ProgressIndicator
Exit Sub
End If
' Set Progress Variables
TotalRows = 1
Counter = 1
Range("A5").Select
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
TotalRows = TotalRows + 1
Loop
' Starting Point
Range("D5").Select
OrigOffset = 0
' Get Invoice Number
Do Until IsEmpty(ActiveCell.Value)
InvNo = ActiveCell.Value
ColorTag = False
ColorTag2 = False
Disp1 = ActiveCell.Offset(0, 5).Value
Disp2 = ActiveCell.Offset(0, 6).Value
ItemAmt = ActiveCell.Offset(0, 2).Value
Counter = Counter + 1
' Find Invoice Number
Sheets(2).Activate
Range("D5").Select
Do Until IsEmpty(ActiveCell) Or ActiveCell.Value = InvNo
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
' Compare Data
If ActiveCell.Offset(0, 5).Value <> Disp1 Then ColorTag = True
If ActiveCell.Offset(0, 6).Value <> Disp2 Then ColorTag = True
If ActiveCell.Offset(0, 2).Value <> ItemAmt Then ColorTag = True
' Tag Different
Sheets(1).Activate
Range("D5").Select
ActiveCell.Offset(OrigOffset, 0).Select
If ColorTag = True Then Call ColorWholeRow

' Update Progress Bar
PctDone = Counter / TotalRows
Call UpdateProgress(PctDone)

' Move to Next Invoice Number
OrigOffset = OrigOffset + 1
ActiveCell.Offset(OrigOffset, 0).Select
Loop
' Unload Progress Bar
Unload ProgressIndicator
Set ProgressIndicator = Nothing
End Sub




Here is a mock-up of the workbook
10663

Any help would be SUPER appreciated.

[p45cal]

In the following code I've just concentrated on highlighting, not bothering with the progress bar. I've also changed the ColorWholeRow sub to prevent it selecting anything and to take an argument:
Sub CompareAccounts4()
Set NewSht = Sheets(1)
Set OldSht = Sheets(2)
'Determine the range on the newer sheet:
Set lastcell = NewSht.Range("A5")
Do Until IsEmpty(lastcell.Offset(1))
Set lastcell = lastcell.Offset(1)
Loop
Set NewCells = Range(NewSht.Range("A5"), lastcell).Offset(, 3)

'Determine the range on the older sheet:
Set lastcell = OldSht.Range("A5")
Do Until IsEmpty(lastcell.Offset(1))
Set lastcell = lastcell.Offset(1)
Loop
Set OldCells = Range(OldSht.Range("A5"), lastcell).Offset(, 3)

'At this stage we have OldCells which is the range of older inv#s,and NewCells which is the range of New Inv#s.
For Each NewCell In NewCells.Cells
For Each OldCell In OldCells.Cells
If OldCell.Value = NewCell.Value Then
If OldCell.Offset(, 2) <> NewCell.Offset(, 2) Or OldCell.Offset(, 5) <> NewCell.Offset(, 5) Or OldCell.Offset(, 6) <> NewCell.Offset(, 6) Then ColorWholeRow NewCell
Exit For 'omit if you want to keep on looking down OldCells for more matches
End If
Next OldCell
Next NewCell
End Sub



Sub ColorWholeRow(TheCell)
With TheCell.EntireRow.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
'.ColorIndex = 3 'I was using Excel2003
.ThemeColor = xlThemeColorAccent1 'commented out for Excel2003
.TintAndShade = 0.799981688894314 'commented out for Excel2003
.PatternTintAndShade = 0 'commented out for Excel2003
End With
End Sub
What this code won't do is highlight new invoice numbers (neither would your code have) but this can be tweaked..

[llldebaserll]

Wow Thanks p45cal! That's WAY more effecient than my coding AND yours works!


There is another small snag that I'm not getting quite right.
I've been informed that there can be Invoices with multiple amounts owed SO any duplicate invoice numbers are being flagged even if they are the same on the old sheet because the sub is comparing against the first entry of the invoice on the old sheet instead of the second.
I tried to add the below code with the intention of manually checking the row above on the old sheet to see if the invoice number and amount matched.
But it doesn't seem to be working and I'm not quite sure why.
Any advice?



If OldCell.Offset(, 2) <> NewCell.Offset(, 3) Or OldCell.Offset(, 5) <> NewCell.Offset(, 6) Or OldCell.Offset(, 6) <> NewCell.Offset(, 7) Then ColorWholeRow NewCell
' Added the below to manually compare against the row above on the old sheet
If NewCell = OldCell.Offset(-1, 0) And NewCell.Offset(, 2) = OldCell.Offset(-1, 2) Then ColorWholeRow2 NewCell
'ColorWholeRow2 just changes the BG back to white

[p45cal]

Yes, I thought that something like this might happen. My first thoughts are that we might attack this in a different way; we could start by highlighting all the rows on the newer sheet, then run through comparig all old entries with all newer entries, and each time we find a duplicate UNhighlight the entry on the newer sheet, when complete, you're left with highlighted rows on the newer sheet where there's no match anywhere on the older sheet (and that would include brand new invoices). As long as you don't get new, legitimate, duplicate entries (these might be repeat orders) with exactly the same values in all the columns you're checking, this should work.
I haven't got time to code this right now, but come back, in the interim, if you think this approach might work or not, and I'll do it.

ps. we don't have to actually highlight everything and unhighlight piecemeal - we can do that virtually and just highlight the newer sheet at the end of the code, but to do so is a way of testing the code visually before tweaking to do it 'virtually'; how many rows on each sheet are we talking about? I ask, because doing most of the processing in memory (virtually) is a lot faster than writing to the sheet many times and you might not even need a progress bar at all.

[llldebaserll]

I got it to do it! Well, not virutally, but it highlights and then unhighlights as accounts check out. On average there are somewhere around 3000-4000 items.

I've been fiddling around with a way to now sort the sheet. Mostly trying to note in a column to the left to group all of the changed rows together.

This is what I've come up with. Sans the sorting attempts because it hasn't been working.

Sub CompareAccounts6()
Set Newsht = Sheets(1)
Set Oldsht = Sheets(2)

'Highlight Entire New Sheet
Newsht.Cells.Select
With Selection.EntireRow.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
'.ColorIndex = 3 'I was using Excel2003
.ThemeColor = xlThemeColorAccent1 'commented out for Excel2003
.TintAndShade = 0.799981688894314 'commented out for Excel2003
.PatternTintAndShade = 0 'commented out for Excel2003
End With

'Determine the range on the newer sheet:
Set lastcell = Newsht.Range("A5")
Do Until IsEmpty(lastcell.Offset(1))
Set lastcell = lastcell.Offset(1)
Loop
Set NewCells = Range(Newsht.Range("A5"), lastcell).Offset(, 3)

'Determine the range on the older sheet:
Set lastcell = Oldsht.Range("A5")
Do Until IsEmpty(lastcell.Offset(1))
Set lastcell = lastcell.Offset(1)
Loop
Set OldCells = Range(Oldsht.Range("A5"), lastcell).Offset(, 3)

'At this stage we have OldCells which is the range of older inv#s,and NewCells which is the range of New Inv#s.
For Each NewCell In NewCells.Cells
For Each OldCell In OldCells.Cells
If OldCell.Value = NewCell.Value Then
If OldCell.Offset(, 2) = NewCell.Offset(, 2) Or OldCell.Offset(, 5) = NewCell.Offset(, 5) Or OldCell.Offset(, 6) = NewCell.Offset(, 6) Then DeColor2 NewCell
End If
Next OldCell
Next NewCell
Range("A5").Select
End Sub

Sub DeColor2(TheCell)
TheCell.EntireRow.Style = "Normal"
End Sub

[p45cal]

Be careful with this line:

If OldCell.Offset(, 2) = NewCell.Offset(, 2) Or OldCell.Offset(, 5) = NewCell.Offset(, 5) Or OldCell.Offset(, 6) = NewCell.Offset(, 6) Then DeColor2 NewCell If any one of the pairs of columns is the same then a row will be decoloured, even if one of the other pairs is different. I suspect that those Ors ought to be Ands.

Also, instead of highlighting the entire new sheet, highlight only after you've determined NewCells:

With NewCells.EntireRow.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End Withwhich also avoids an error on the Select line if that new sheet doesn't happen to be the active sheet at the time.

I think you can sort on colour in excel2007 onwards.

[llldebaserll]

Thanks a ton p45cal!

It seems to be working great now.