Forum Discussion
Data Sheet Compare Macro
Here is a code that is untested, maybe it will help you.
Sub CompareTwoTables()
Dim tbl1 As ListObject, tbl2 As ListObject
Dim rngCell As Range
' Set references to the tables
Set tbl1 = Worksheets("Sheet1").ListObjects("Table1")
Set tbl2 = Worksheets("Sheet2").ListObjects("Table2")
' Loop through each cell in the first table
For Each rngCell In tbl1.DataBodyRange
' Compare cell values between tables
If rngCell.Value <> tbl2.DataBodyRange.Cells(rngCell.Row, rngCell.Column).Value Then
' Highlight the entire row in yellow
tbl1.ListRows(rngCell.Row - tbl1.HeaderRowRange.Row + 1).Range.Interior.Color = vbYellow
tbl2.ListRows(rngCell.Row - tbl1.HeaderRowRange.Row + 1).Range.Interior.Color = vbYellow
' Change font color to red
rngCell.Font.Color = vbRed
tbl2.DataBodyRange.Cells(rngCell.Row, rngCell.Column).Font.Color = vbRed
End If
Next rngCell
End Sub
For security reasons, I don't open any external files at the moment.
If it is not what you have in mind, please provide more details about what you would like to achieve, step by step if possible, so that I can understand the translation
.
Please see the attached photos for what I am trying to accomplish with the Macro. Basically, I have a table that will always stay unformatted since it is the "Yesterday Data" since I want to highlight any changes. Once I run the query, the "Today Data" table will shift to a "Yesterday Data" sheet as a table and the query will pull the new data and place it in a "Today Data" sheet as a table. At that point, I will need to highlight if there are any changes in the following formats:
New row added to the table: Highlight the entire row "Yellow" and format text as "Green"
Update to data: Highlight the specific cell that changed "Yellow" and format the entire row text as "Red"
I hope this helps! I tried running your code and it worked fine but not for this comparison application as I need to visually analyze the changed or newly added data on one sheet.
Here is my updates to the code... I am trying to figure out how to perform a FOR IF loop for if a new row is added but I can't find anything on how to do it.
Sub CompareTwoTables()
Dim tbl1 As ListObject, tbl2 As ListObject
Dim rngCell As Range
' Set references to the tables
Set tbl1 = Worksheets("YESTERDAY SHEET").ListObjects("YesterdayData")
Set tbl2 = Worksheets("TODAY SHEET - MACRO").ListObjects("TodayData")
' Loop through each cell in the "Yesterday Data" table
For Each rngCell In tbl2.DataBodyRange
' Compare cell values between tables
If rngCell.Value <> tbl1.DataBodyRange.Cells(rngCell.Row, rngCell.Column).Value Then
' Highlights cell that is differnt "Yellow"
tbl2.Range(selCell.Address).Interior.Color = vbYellow
' Change font color to red
tbl2.DataBodyRange.Cells(rngCell.Row, rngCell.Column).Font.Color = vbRed
End If
' Loop for if a new row is added
For Each Rng In CellIntbl2.DataBodyRange
If
tbl2.ListRows(rngCell.Row - tbl1.HeaderRowRange.Row + 1).Range.Interior.Color = vbYellow
tbl2.DataBodyRange.Cells(rngCell.Row, rngCell.Column).Font.Color = vbGreen
End If
Next rngCell
End Sub
Thank you so much! I greatly appreciate the help!
Marshall
- NikolinoDEMar 04, 2024Platinum Contributor
It seems like you're on the right track, as far as I can see it. Let's address your requirements:
- Highlighting Changed Cells in Yellow and Formatting Font to Red: Your existing code snippet inside the loop should work for this requirement. It compares the cell values between the two tables and highlights the cell yellow if they are different, then changes the font color to red.
- Highlighting New Rows in Yellow and Formatting Font to Green: For this, you need to identify rows that exist in the "Today Data" table but not in the "Yesterday Data" table. You can achieve this by looping through each row in the "Today Data" table and checking if the corresponding row exists in the "Yesterday Data" table. If it doesn't, then it's a new row and you can highlight the entire row in yellow and format the font to green.
Here's how you can maybe implement it:
Vba code is untested.
Sub CompareTwoTables() Dim tbl1 As ListObject, tbl2 As ListObject Dim rngCell As Range, rowToday As Range Dim foundRow As Boolean ' Set references to the tables Set tbl1 = Worksheets("YESTERDAY SHEET").ListObjects("YesterdayData") Set tbl2 = Worksheets("TODAY SHEET - MACRO").ListObjects("TodayData") ' Loop through each cell in the "Today Data" table For Each rngCell In tbl2.DataBodyRange ' Compare cell values between tables If rngCell.Value <> tbl1.DataBodyRange.Cells(rngCell.Row, rngCell.Column).Value Then ' Highlight the changed cell in yellow tbl2.Cells(rngCell.Row, rngCell.Column).Interior.Color = vbYellow ' Change font color to red tbl2.Cells(rngCell.Row, rngCell.Column).Font.Color = vbRed End If Next rngCell ' Loop through each row in the "Today Data" table For Each rowToday In tbl2.ListRows foundRow = False ' Check if the row exists in the "Yesterday Data" table For Each rowYesterday In tbl1.ListRows If Join(Application.Transpose(rowToday.Range.Value), "|") = Join(Application.Transpose(rowYesterday.Range.Value), "|") Then foundRow = True Exit For End If Next rowYesterday ' If the row doesn't exist in the "Yesterday Data" table, it's a new row If Not foundRow Then ' Highlight the entire row in yellow rowToday.Range.Interior.Color = vbYellow ' Format font color to green rowToday.Range.Font.Color = vbGreen End If Next rowToday End SubThis code will iterate through each cell in the "Today Data" table, comparing it with the corresponding cell in the "Yesterday Data" table. If a difference is found, it highlights the cell in yellow and changes the font color to red. Then, it iterates through each row in the "Today Data" table to check if it exists in the "Yesterday Data" table. If not, it highlights the entire row in yellow and formats the font color to green.
- marshalltj67Mar 04, 2024Brass Contributor
Note. I changed the "set" table to "YesterdayDataTable" and "TodayDataTable" to avoid confusion:
I was able to figure out the first loop with this code:
For Each rngCell In TodayDataTable.DataBodyRange If rngCell.Value <> YesterdayDataTable.Range(rngCell.row, rngCell.Column).Value Then TodayDataTable.Range(rngCell.row, rngCell.Column).Interior.Color = vbYellow TodayDataTable.Range(rngCell.row, rngCell.Column).EntireRow.Font.Color = vbRed End If Next rngCellI am still having trouble with the second loop for finding if a row as been added. Was rowYesterday supposed to be in the defined as a range along with rowToday? Here is what I have as a whole and I keep getting the attached error for "Compile Error - Argument Not Optional". I think the compile error is happening in the following code:
"If Join(Application.Transpose(rowToday.Range.Value), "|") = Join(Application.Transpose(rowYesterday.Range.Value), "|") Then"
Thank you!
Sub CompareTwoTables() Dim YesterdayDataTable As ListObject, TodayDataTable As ListObject Dim rngCell As Range, rowToday As Range, rowYesterday As Range Dim foundRow As Boolean ' Reference Tables Set YesterdayDataTable = Worksheets("YESTERDAY SHEET").ListObjects("YesterdayData") Set TodayDataTable = Worksheets("TODAY SHEET - MACRO").ListObjects("TodayData") ' Loop 1 - For Each rngCell In TodayDataTable.DataBodyRange If rngCell.Value <> YesterdayDataTable.Range(rngCell.row, rngCell.Column).Value Then TodayDataTable.Range(rngCell.row, rngCell.Column).Interior.Color = vbYellow TodayDataTable.Range(rngCell.row, rngCell.Column).EntireRow.Font.Color = vbRed End If Next rngCell ' Loop 2 - ' Loop through each row in the "Today Data" table For Each rowToday In TodayDataTable.ListRows foundRow = False ' Check if the row exists in the "Yesterday Data" table For Each rowYesterday In YesterdayDataTable.ListRows If Join(Application.Transpose(rowToday.Range.Value), "|") = Join(Application.Transpose(rowYesterday.Range.Value), "|") Then foundRow = True Exit For End If Next rowYesterday ' If the row doesn't exist in the "Yesterday Data" table, it's a new row If Not foundRow Then ' Highlight the entire row in yellow rowToday.Range.Interior.Color = vbYellow ' Format font color to green rowToday.Range.Font.Color = vbGreen End If Next rowToday End Sub- NikolinoDEMar 05, 2024Platinum Contributor
The issue you're encountering seems to be related to how you're attempting to compare rows in your tables. Let's try to address each problem individually:
- Run-time error '438' - Object doesn't support this property or method: This error occurs because you're trying to use the .Range property on a ListObject object. However, the ListObject doesn't have a .Range property. Instead, you should access the individual cells using the .DataBodyRange property of the ListObject. You've already used this correctly in your first loop. So, you should apply the same approach to your second loop.
- Compile Error: Argument not optional: This error occurs because the Join function requires two arguments - the array you want to join and the delimiter. It seems you're missing the delimiter argument in your Join function calls.
Here's how you can maybe fix your second loop and address these issues:
Sub CompareTwoTables() Dim YesterdayDataTable As ListObject, TodayDataTable As ListObject Dim rngCell As Range, rowToday As ListRow, rowYesterday As ListRow Dim foundRow As Boolean ' Reference Tables Set YesterdayDataTable = Worksheets("YESTERDAY SHEET").ListObjects("YesterdayData") Set TodayDataTable = Worksheets("TODAY SHEET - MACRO").ListObjects("TodayData") ' Loop 1: Highlight changed cells For Each rngCell In TodayDataTable.DataBodyRange If rngCell.Value <> YesterdayDataTable.DataBodyRange.Cells(rngCell.Row, rngCell.Column).Value Then rngCell.Interior.Color = vbYellow rngCell.Font.Color = vbRed End If Next rngCell ' Loop 2: Highlight new rows For Each rowToday In TodayDataTable.ListRows foundRow = False For Each rowYesterday In YesterdayDataTable.ListRows If Join(Application.Transpose(rowToday.Range.Value), "|") = Join(Application.Transpose(rowYesterday.Range.Value), "|") Then foundRow = True Exit For End If Next rowYesterday ' If the row doesn't exist in the "Yesterday Data" table, it's a new row If Not foundRow Then rowToday.Range.Interior.Color = vbYellow rowToday.Range.Font.Color = vbGreen End If Next rowToday End SubIn the second loop, I've made the following changes:
- Changed rowToday and rowYesterday from Range objects to ListRow objects, as they represent entire rows in your tables.
- Ensured that the delimiter argument (|) is included in the Join function calls.
Try running this updated code, and it should resolve the errors you've encountered. The text, steps and the code were created with the help of AI.
My answers are voluntary and without guarantee!
Hope this will help you.
Was the answer useful? Mark as best response and like it!
This will help all forum participants.
- marshalltj67Mar 04, 2024Brass ContributorFor the first loop I am getting an "Run-time error '438' - Object doesn't support this property or method" error and for the second loop I am getting a "Compile Error: Argument not optional" error
Does this have to do with how the initial Dim code is written for setting the initial ranges?