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
Process-MockUp.xlsm

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 With

which 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.