Barim, I begun work on this and got the "Change" case where if it is highlighted, add it to the report sheet, see below code.
After you implement this, let me know what you still need. I would have it all done, however some of your requests are a bit confusing.
For example:
-For the change case, are rows only ever going to be highlighted in the "New" sheet? Also, only rows D-F? Or A-F?
-For the "Add" case, are you comparing the rows of OLD and NEW and if NEW has something that OLD doesnt, add it to report?
Let me know if you need anything further.
Sub RunReport()
Dim WBT As Workbook
Dim WPN As Worksheet
Dim oldSheet As Worksheet
Dim newSheet As Worksheet
Dim ListOld(), ListNew()
Dim change As String
Dim add As String
Dim missing As String
change = "Change"
add = "Add"
missing = "Missing"
' Set workbook/worksheet variables
Set WBT = ThisWorkbook
Set WPN = WBT.Sheets(3)
Set oldSheet = WBT.Sheets(1)
Set newSheet = WBT.Sheets(2)
firstRow = 2 ' Row after header
lastRowOld = oldSheet.Cells(Rows.Count, "A").End(xlUp).Row
lastRowNew = newSheet.Cells(Rows.Count, "A").End(xlUp).Row
reportLastRow = WPN.Cells(Rows.Count, "A").End(xlUp).Row
With oldSheet
ListOld = Range(.Cells(firstRow, 2), .Cells(lastRowOld, 2)).Value
End With
With newSheet
ListNew = Range(.Cells(firstRow, 2), .Cells(lastRowNew, 2)).Value
End With
' New Case
Dim ColorValues() As Variant
ReDim ColorValues(LBound(ListNew) To UBound(ListNew))
Dim table As Range
For i = LBound(ColorValues) To UBound(ColorValues)
Set table = newSheet.Range("C" & i)
ColorValues(i) = table.Interior.Color
If ColorValues(i) <> 16777215 Then
newSheet.Rows(i).Copy WPN.Rows(reportLastRow + 1)
newSheet.Cells(reportLastRow, 6).Value = change
reportLastRow = reportLastRow + 1
End If
Set table = newSheet.Range("D" & i)
ColorValues(i) = table.Interior.Color
If ColorValues(i) <> 16777215 Then
newSheet.Rows(i).Copy WPN.Rows(reportLastRow + 1)
newSheet.Cells(reportLastRow, 6).Value = change
reportLastRow = reportLastRow + 1
End If
Set table = newSheet.Range("E" & i)
ColorValues(i) = table.Interior.Color
If ColorValues(i) <> 16777215 Then
newSheet.Rows(i).Copy WPN.Rows(reportLastRow + 1)
newSheet.Cells(reportLastRow, 6).Value = change
reportLastRow = reportLastRow + 1
End If
Next i
End Sub