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.
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:
I'll happily answer any questions or provide all three files in question if needed.
Best wishes,
TimidBee
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