PDA

View Full Version : Compare if any changes then highlight



barim
01-25-2017, 12:35 PM
I have one workbook and 2 worksheets.

The first worksheet is where my database is stored. The second sheet is my File that I need to compare against database. As you can see from the attached sample workbook, the first column is used to search UniqeID. Once when ID is being matched the macro should compare Item # from Database to Item # from File and check if anything changed. Same procedure should be applied to the next cell which is Description and then Manufacturer. As you can see for the UniqueID 8, description changed from Description 8 to Description50 and it is highlighted. Then, Manufacturer also changed and it is highlighted. Item # didn’t change so it shouldn’t be highlighted.

Same rules apply to each line, whatever changed in the database compare it to the file and highlight all changes that have been made in Database. All highlights should be placed inside File and not Database worksheet. I hope this is not too complicated. Thank you in advance for your help.

Paul_Hossler
01-25-2017, 05:10 PM
Try this




Option Explicit
Sub Compare2()
Dim rDatabase As Range, rFile As Range
Dim iFile As Long, iDatabase As Long, iColumn As Long

Set rDatabase = Worksheets("Database").Cells(1, 1).CurrentRegion
Set rFile = Worksheets("File").Cells(1, 1).CurrentRegion

For iFile = 2 To rFile.Rows.Count

iDatabase = -1

On Error Resume Next
iDatabase = Application.WorksheetFunction.Match(rFile.Cells(iFile, 1).Value, rDatabase.Columns(1), 0)
On Error GoTo 0

If iDatabase <> -1 Then
For iColumn = 2 To rFile.Columns.Count
If rFile.Cells(iFile, iColumn).Value <> rDatabase.Cells(iDatabase, iColumn).Value Then
rFile.Cells(iFile, iColumn).Interior.Color = vbRed
End If
Next iColumn
End If
Next iFile

End Sub

barim
01-26-2017, 09:43 PM
Paul, this code is brilliant. What surprises me is its speed. I tested it against the file that has more than 1 million rows and execution time was almost instant.

I have one question for you. Could you explain me what role has -1?
Thank you so much. :hi:

Paul_Hossler
01-27-2017, 09:14 AM
If the MATCH() function does not find a match value (rFile.Cells(iFile, 1).Value) in the range it's searching (rDatabase.Columns(1)) it returns an error; otherwise it returns the position (index value) of where the match is (1 - n)

There's many ways to handle a match not being found, but I'm just used to setting the position variable to -1, turning off error checking so that a mis-match doesn't cause a debug, and then turning error checking back on

If there is an error, then the variable is still -1, otherwise it holds the position number and I can handle either situation



iDatabase = -1

On Error Resume Next
iDatabase = Application.WorksheetFunction.Match(rFile.Cells(iFile, 1).Value, rDatabase.Columns(1), 0)
On Error GoTo 0

barim
01-31-2017, 09:29 AM
While running this code I encountered issue with one column only. It seems to me that it has to do something with formatting. The numbers are completely the same in both columns but it highlighted the whole column. I found out that one column was formatted as text while the other as number. So, I guess that this could be reason why. Is there any way that we can bypass this formatting and check values only? :think:

Thanks again.

Paul_Hossler
01-31-2017, 10:24 AM
Post a small sample workbook and I'll look

barim
01-31-2017, 01:00 PM
Thanks for the response. Attached is my sample file. On the "File" tab check the first data line (row 2), and as you can see some values match but macro highlights it as different.



555444
Customer 1
5000



These values are same and should not be highlighted.

It is only the first row. The rest in that column seems ok.

Thank you again for your response.

Paul_Hossler
01-31-2017, 02:09 PM
Try this and let me know





Option Explicit
Sub Compare3()
Dim rDatabase As Range, rFile As Range
Dim iFile As Long, iDatabase As Long, iColumn As Long

Set rDatabase = Worksheets("Database").Cells(1, 1).CurrentRegion
Set rFile = Worksheets("File").Cells(1, 1).CurrentRegion

rFile.Interior.Color = xlNone

For iFile = 2 To rFile.Rows.Count

iDatabase = -1

On Error Resume Next
iDatabase = Application.WorksheetFunction.Match(rFile.Cells(iFile, 1).Value, rDatabase.Columns(1), 0)
On Error GoTo 0

If iDatabase <> -1 Then
For iColumn = 2 To rFile.Columns.Count
' changed to add CStr()'s
If CStr(rFile.Cells(iFile, iColumn).Value) <> CStr(rDatabase.Cells(iDatabase, iColumn).Value) Then
rFile.Cells(iFile, iColumn).Interior.Color = vbRed
End If
Next iColumn
End If
Next iFile

End Sub

barim
02-06-2017, 08:48 AM
Paul, thanks for this help again. :hi:CStr() fixed the problem and it seems to me that the code is running much faster now. So, CStr converts any value to a string and even if the whole columns are formatted as text, general, number, date etc. Do I have to watch for this formatting since it seems that CStr() takes care of that? Just to be on the safe side, I am converting every column to text before I run the code.

itipu
11-15-2017, 09:50 PM
Hello Paul,

Was looking at your code, as I can use it rather nicely, modified it just slightly as I need to mark up both sheets.... but I can't seem to figure out how to highlight additions/deletions - so if in Sheet1, there is a row with Unique Value, but no such row in Sheet2, I'd like it highlighted, and the same with additions.

I modified code a little as follows - probably not the fastest way, but it marks up both sheets nicely, except for additions and deletions - I changed Unique Value to column 9, but in your sample Sheet it was 2, so needs to be changed back - Thank you for your thoughts!!!:


Option Explicit
Sub Compare3()
Dim rDatabase As Range, rFile As Range
Dim iFile As Long, iDatabase As Long, iColumn As Long

Set rDatabase = Worksheets("Sheet1").Cells(1, 1).CurrentRegion
Set rFile = Worksheets("Sheet2").Cells(1, 1).CurrentRegion

rFile.Interior.Color = xlNone
rDatabase.Interior.Color = xlNone

For iFile = 2 To rFile.Rows.Count

iDatabase = -1

On Error Resume Next
iDatabase = Application.WorksheetFunction.Match(rFile.Cells(iFile, 9).Value, rDatabase.Columns(9), 0)
On Error GoTo 0

If iDatabase <> -1 Then
For iColumn = 2 To rFile.Columns.Count
' changed to add CStr()'s
If CStr(rFile.Cells(iFile, iColumn).Value) <> CStr(rDatabase.Cells(iDatabase, iColumn).Value) Then
rFile.Cells(iFile, iColumn).Interior.Color = vbRed
End If
Next iColumn
End If
Next iFile

For iDatabase = 2 To rDatabase.Rows.Count

iFile = -1

On Error Resume Next
iFile = Application.WorksheetFunction.Match(rDatabase.Cells(iDatabase, 9).Value, rFile.Columns(9), 0)
On Error GoTo 0

If iFile <> -1 Then
For iColumn = 2 To rDatabase.Columns.Count
' changed to add CStr()'s
If CStr(rDatabase.Cells(iDatabase, iColumn).Value) <> CStr(rFile.Cells(iFile, iColumn).Value) Then
rDatabase.Cells(iDatabase, iColumn).Interior.Color = vbYellow
End If
Next iColumn
End If
Next iDatabase

End Sub

Paul_Hossler
11-16-2017, 12:28 PM
Give this a shot

Let me know




Option Explicit

Sub Compare4()
Dim rDatabase As Range, rFile As Range
Dim iFile As Long, iDatabase As Long, iColumn As Long

Set rDatabase = Worksheets("Sheet1").Cells(1, 1).CurrentRegion
Set rFile = Worksheets("Sheet2").Cells(1, 1).CurrentRegion

rFile.Interior.Color = xlNone
rDatabase.Interior.Color = xlNone

For iFile = 2 To rFile.Rows.Count

iDatabase = -1

On Error Resume Next
iDatabase = Application.WorksheetFunction.Match(rFile.Cells(iFile, 2).Value, rDatabase.Columns(2), 0)
On Error GoTo 0

'found row on other sheet
If iDatabase <> -1 Then
For iColumn = 2 To rFile.Columns.Count
' changed to add CStr()'s
If CStr(rFile.Cells(iFile, iColumn).Value) <> CStr(rDatabase.Cells(iDatabase, iColumn).Value) Then
rFile.Cells(iFile, iColumn).Interior.Color = vbRed
End If
Next iColumn

'did not find row in rDatabase so this must have been added to rFile
Else
For iColumn = 2 To rFile.Columns.Count
rFile.Cells(iFile, iColumn).Interior.Color = vbCyan
Next iColumn
End If
Next iFile

For iDatabase = 2 To rDatabase.Rows.Count

iFile = -1

On Error Resume Next
iFile = Application.WorksheetFunction.Match(rDatabase.Cells(iDatabase, 2).Value, rFile.Columns(2), 0)
On Error GoTo 0

If iFile <> -1 Then
For iColumn = 2 To rDatabase.Columns.Count
' changed to add CStr()'s
If CStr(rDatabase.Cells(iDatabase, iColumn).Value) <> CStr(rFile.Cells(iFile, iColumn).Value) Then
rDatabase.Cells(iDatabase, iColumn).Interior.Color = vbYellow
End If
Next iColumn

'did not find row in rFile this must be deleted from rFile
Else
For iColumn = 2 To rDatabase.Columns.Count
rDatabase.Cells(iDatabase, iColumn).Interior.Color = vbGreen
Next iColumn

End If
Next iDatabase

End Sub

itipu
11-18-2017, 04:47 AM
Thank you very much Paul - this is pretty perfect, one further refinement - what if I only want to highlight changes in Sheet2, Column "D" if they are from "No Value" to "Value" i.e. not if value changes, but only if it goes from blank to value? Thx, Mike

Paul_Hossler
11-18-2017, 06:48 AM
Added a couple of lines where marked




Option Explicit
Sub Compare5()
Dim rSheet1 As Range, rSheet2 As Range
Dim iSheet2 As Long, iSheet1 As Long, iColumn As Long

Set rSheet1 = Worksheets("Sheet1").Cells(1, 1).CurrentRegion
Set rSheet2 = Worksheets("Sheet2").Cells(1, 1).CurrentRegion

rSheet2.Interior.Color = xlNone
rSheet1.Interior.Color = xlNone

For iSheet2 = 2 To rSheet2.Rows.Count

If iSheet2 = 13 Then Stop

iSheet1 = -1

On Error Resume Next
iSheet1 = Application.WorksheetFunction.Match(rSheet2.Cells(iSheet2, 2).Value, rSheet1.Columns(2), 0)
On Error GoTo 0

'found row on Sheet2
If iSheet1 <> -1 Then
For iColumn = 2 To rSheet2.Columns.Count
If CStr(rSheet2.Cells(iSheet2, iColumn).Value) <> CStr(rSheet1.Cells(iSheet1, iColumn).Value) Then
'change v5 - Sheet1 not blank, but sheet2 is blank
If Len(rSheet2.Cells(iSheet2, iColumn).Value) = 0 And Len(rSheet1.Cells(iSheet2, iColumn).Value) > 0 Then
rSheet2.Cells(iSheet2, iColumn).Interior.Color = vbBlue
Else
rSheet2.Cells(iSheet2, iColumn).Interior.Color = vbRed
End If
End If
Next iColumn

'did not find row in rSheet1 so this must have been deleted from rSheet1
Else
For iColumn = 2 To rSheet2.Columns.Count
rSheet2.Cells(iSheet2, iColumn).Interior.Color = vbCyan
Next iColumn
End If
Next iSheet2

For iSheet1 = 2 To rSheet1.Rows.Count

iSheet2 = -1

On Error Resume Next
iSheet2 = Application.WorksheetFunction.Match(rSheet1.Cells(iSheet1, 2).Value, rSheet2.Columns(2), 0)
On Error GoTo 0

If iSheet2 <> -1 Then
For iColumn = 2 To rSheet1.Columns.Count
If CStr(rSheet1.Cells(iSheet1, iColumn).Value) <> CStr(rSheet2.Cells(iSheet2, iColumn).Value) Then
rSheet1.Cells(iSheet1, iColumn).Interior.Color = vbYellow
End If
Next iColumn

'did not find row in rSheet1 this must be added to rSheet2
Else
For iColumn = 2 To rSheet1.Columns.Count
rSheet1.Cells(iSheet1, iColumn).Interior.Color = vbGreen
Next iColumn

End If
Next iSheet1

End Sub