[VBA] Compare Two Sheets, Highlight Differences, But Consider Add/Remove Rows

TimidBee

New Member
Joined
Aug 4, 2022
Messages
1
Office Version
  1. 365
  2. 2011
Platform
  1. Windows
  2. MacOS
Hi,

This is my second code in VBA, which will hopefully work; so consider me a beginner. I have two workbooks that I want to compare and highlight differences. I've prepared a VBA code but if any rows are added or deleted it marks them too, which goes against what I want to do.

Aim:
Every time I create a new worksheet, there will be differences. Sometimes only dates and times are changed, but often new rows of information are added or deleted. Our database outputs a Word document, listing all the changes; my job is to check the Word document, and highlight all changes listed there in the new workbook.

Instead of pulling everything from the Word document, I thought it would be easier to compare the old workbook to the new output.

The problem:
If there are new rows added, or deleted, the code below highlights more cells than I want.

VBA Code:
[CODE=vba]
Dim mycells As Range
    
For Each mycells In ActiveWorkbook.Worksheets(1).UsedRange
    If Not mycells.Value = ActiveWorkbook.Worksheets(2).Cells(mycells.Row, mycells.Column).Value Then
    
    mycells.Interior.Color = vbYellow

This bit is the first problem, the next step for my code is to hide all rows which have cells without fill color.

Here's the whole code:
VBA Code:
Sub compare()

'declare file paths
    Dim oldfile As Variant
    Dim newfile As Variant

'not used now, couldn't assign names to open workbooks, using active and last active workbooks now
    ''Dim wb1 As Workbook
    ''Set wb1 = ActiveWorkbook
    
'save last row and column number
    Dim lastrow As Long
        lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    'assign loop variable
    Dim loopcell As Long
    
'prompt for back-up, end if cancel
    resp = MsgBox("Please back-up the files first!", vbOKCancel, "Back-up Warning")
    If resp = vbCancel Then
        End
    End If

'assign variables to filepaths
oldfile = Application.GetOpenFilename(, Title:="Choose Old File", Buttontext:="Choose Old File")

'no idea why I had to add this logic about file name not empty, but it wouldn't work otherwise
If oldfile <> False Then
    Workbooks.Open (oldfile)
End If

newfile = Application.GetOpenFilename(, Title:="Choose New File", Buttontext:="Choose New File")

'same with old file
If newfile <> False Then
    Workbooks.Open (newfile)
End If

'not used now
    ''ActiveSheet.UsedRange.Copy
    ''ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)

'activate old file
Workbooks(Workbooks.Count - 1).Activate

'copy info from old file
ActiveSheet.UsedRange.Copy

'activate new file
Workbooks(Workbooks.Count).Activate

'add sheet to the end of the new file
ActiveWorkbook.Sheets.Add after:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)

'paste info from old file to sheet2 of new file
ActiveSheet.Paste

'loop to check for exact matches, highlight yellow when unique values
'save range to local memory
    Dim mycells As Range
    'save variable number to show how many changes are made
    Dim diffnumber As Integer
    
For Each mycells In ActiveWorkbook.Worksheets(1).UsedRange
    If Not mycells.Value = ActiveWorkbook.Worksheets(2).Cells(mycells.Row, mycells.Column).Value Then
    
    mycells.Interior.Color = vbYellow
    diffnumber = diffnumber + 1
    
    End If
Next

MsgBox diffnumber & " differences found", vbInformation

'activate worksheet number1
'ActiveWorkbook.Sheets(2).Delete
ActiveWorkbook.Sheets(1).Activate


'Dim lastrow2 As Long
'lastrow2 = Cells(Rows.Count, 1).End(xlUp).Row

'new code to hide rows if no cells are highlighed
    Dim startColumn As Integer
    Dim startRow As Integer

    Dim totalRows As Integer
    Dim totalColumns As Integer

    Dim currentColumn As Integer
    Dim currentRow As Integer

    Dim shouldHideRow As Integer

    startColumn = 1     'column A
    startRow = 1        'row 1
    totalRows = Sheet1.Cells(Rows.Count, startColumn).End(xlUp).Row
    
    For currentRow = totalRows To startRow Step -1
        shouldHideRow = True
        totalColumns = Sheet1.Cells(currentRow, Columns.Count).End(xlToLeft).Column
        'for each column in the current row, check the cell color
        For currentColumn = startColumn To totalColumns
            'if any colored cell is found, don't hide the row and move on to next row
            If Not Sheet1.Cells(currentRow, currentColumn).Interior.Color = RGB(255, 255, 255) Then
                shouldHideRow = False
                Exit For
            End If
        Next

        If shouldHideRow Then
            'drop into here if all cells in a row were white
            Sheet1.Cells(currentRow, currentColumn).EntireRow.Hidden = True
        End If
    Next


''hide all cells unhighlighted cells (oldcode, works badly; only hides rows if the first column is highlighted, if there are no changes in column A, it doesn't hide the row: otherwise it works, albeit very slowly)
'With ActiveWorkbook
'For loopcell = 1 To lastrow2
    'If Cells(loopcell, lastrow).Interior.Color = RGB(255, 255, 255) Then
    'Rows(loopcell).Hidden = True
    'End If
'Next loopcell
'End With

End Sub

I'll happily answer any questions or provide all three files in question if needed.

Best wishes,
TimidBee
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Forum statistics

Threads
1,223,884
Messages
6,175,175
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top