Forum Discussion
Data Sheet Compare Macro
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
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.
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 SubThe 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.
After doing some more research, I found the error is fixed when performing a redundant double transposition. I do not know if this changes the function of that line but I think that error was due to it not inputting a 1 dim array into the "Source Array" for the Join("Source Array" , Delimiter: "|"). Please let me know if this affects the function of the code since I am now seeing issues with the output format.
Please see the following:
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 - 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 - For Each rowToday In TodayDataTable.ListRows foundRow = False For Each rowYesterday In YesterdayDataTable.ListRows If Join((Application.Transpose(Application.Transpose(rowToday.Range.Value))), "|") = Join((Application.Transpose(Application.Transpose(rowYesterday.Range.Value))), "|") Then foundRow = True Exit For End If Next rowYesterday If Not foundRow Then rowToday.Range.Font.Color = vbGreen rowToday.Range.Interior.Color = vbYellow End If Next rowToday End SubThe output of the second loop seems to overwrite the first loop formatting on the "Today Data Table" as it highlights all cells yellow and changes all font to green (See attached - "Table Error (All Values Overwrited by Loop 2)". The following code works for the first loops as intended but still gets overwrited by the second loop (See attached - "Loop 1 - Correct Format"):
' 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 End SubI know you said your answers are voluntary and not guaranteed so I appreciate any assistance you can provide.. I think the main function is there I am just wondering if you had any guidance on any additional small kinks to the code.
Thanks again man!
Marshall
- For 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?
.png){kind=link}