VBA macro to compare sheets and list exceptions in different sheet

[Riptake]

Hi guys,

I needed some help in updating a VBA code for carrying out the task mentioned above. The only issue I have is how the info. is represented in the exceptions sheet. I want to show only the data labels that have changed and also lists before and after. Also it would be helpful if the info is displayed on a column format as opposed to a row format.

Please help if possible. Would really appreaciate it.

Thanks

Code (please paste into Sheet3):

Option Explicit
Dim miMaxColumns As Integer
Sub CompareSheets()
Dim bChanged As Boolean, baChanged() As Boolean
Dim iColEnd As Integer, iCol As Integer, iCol1 As Integer, iCol2 As Integer
Dim lRow1 As Long, lRow2 As Long, lReportRow As Long
Dim objDictOld As Object, objDictNew As Object
Dim vKeys As Variant, vKey As Variant
Dim vaInput() As Variant, vaOutput() As Variant, vaOutput2() As Variant
Dim vaInputOld As Variant, vaInputNew As Variant
Dim wsOld As Worksheet, wsNew As Worksheet, wsReport As Worksheet
Dim ConfirmStart As String, ConfirmSort As String, ConfirmName As String

'\\\Ask user to confirm starting database comparison program.
ConfirmStart = MsgBox(prompt:="This will compare Sheet1 to Sheet2." & Chr(13) _
& "Column A of each sheet should be a unique identifier." & Chr(13) _
& Chr(13) & "It is advised to sort the data being compared (in both sheets) in ascending order by the unique identifier" & Chr(13) _
& Chr(13) & "Do you want to continue?", Buttons:=vbYesNo Or vbQuestion, Title:="Compare CMBS Tapes")
If ConfirmStart = vbNo Then Exit Sub
Set wsOld = Sheets("Sheet1")
miMaxColumns = wsOld.Cells(1, Columns.Count).End(xlToLeft).Column
Set objDictOld = PopulateDictionary(WS:=wsOld)
Set wsNew = Sheets("Sheet2")
Set objDictNew = PopulateDictionary(WS:=wsNew)
Set wsReport = Sheets("ExceptionSummary")
With wsReport
.Cells.ClearFormats
.Cells.ClearContents
End With
wsOld.Range("A1:" & wsOld.Cells(1, miMaxColumns).Address).Copy
wsReport.Range("B3").PasteSpecial (xlPasteAll)

Application.CutCopyMode = False
lReportRow = 3
vKeys = objDictOld.Keys
For Each vKey In vKeys
ReDim vaInputOld(1 To 1, 1 To miMaxColumns)
vaInputOld = objDictOld.Item(vKey)
If objDictNew.exists(vKey) Then
ReDim vaInputNew(1 To 1, 1 To miMaxColumns)
vaInputNew = objDictNew.Item(vKey)
ReDim vaOutput(1 To 1, 1 To miMaxColumns + 1)
ReDim vaOutput2(1 To 1, 1 To miMaxColumns + 1)
ReDim baChanged(1 To miMaxColumns)
bChanged = False
For iCol = 1 To miMaxColumns
vaOutput(1, iCol + 1) = vaInputOld(1, iCol)
If vaInputOld(1, iCol) <> vaInputNew(1, iCol) Then
vaOutput2(1, iCol + 1) = vaInputNew(1, iCol)
baChanged(iCol) = True
bChanged = True
End If
Next iCol
If bChanged Then
lReportRow = lReportRow + 1
For iCol = 1 To UBound(baChanged)
If baChanged(iCol) Then
With wsReport
.Range(.Cells(lReportRow, iCol + 1).Address, _
.Cells(lReportRow + 1, iCol + 1).Address).Interior.Color = vbYellow
End With
End If
Next iCol

vaOutput(1, 1) = "Changed"
With wsReport
.Range(.Cells(lReportRow, 1).Address, _
.Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput
lReportRow = lReportRow + 1
.Range(.Cells(lReportRow, 1).Address, _
.Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput2
End With
End If
objDictOld.Remove vKey
objDictNew.Remove vKey
Else
ReDim vaOutput(1 To 1, 1 To miMaxColumns + 1)
vaOutput(1, 1) = "Deleted"
For iCol = 1 To miMaxColumns
vaOutput(1, iCol + 1) = vaInputOld(1, iCol)
Next iCol

lReportRow = lReportRow + 1
With wsReport
.Range(.Cells(lReportRow, 1).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput
'-- Set the row to light grey
.Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Interior.ColorIndex = 15
End With
End If
Next vKey
If objDictNew.Count <> 0 Then
vKeys = objDictNew.Keys
For Each vKey In vKeys
ReDim vaOutput2(1 To 1, 1 To miMaxColumns + 1)
vaInputNew = objDictNew.Item(vKey)
vaOutput2(1, 1) = "Inserted"
For iCol = 1 To miMaxColumns
vaOutput2(1, iCol + 1) = vaInputNew(1, iCol)
Next iCol
lReportRow = lReportRow + 1
With wsReport
.Range(.Cells(lReportRow, 1).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput2
'-- Set the row to light green
.Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Interior.ColorIndex = 4
End With
Next vKey
End If
objDictOld.RemoveAll
Set objDictOld = Nothing
objDictNew.RemoveAll
Set objDictNew = Nothing
End Sub