Sub CompareSheetsAndFindMissing()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long
Dim dict As Object
Dim cell As Range
Dim resultSheet As Worksheet
' Set the sheets
Set ws1 = [Link]("Sheet1")
Set ws2 = [Link]("RESPONSE")
' Find the last rows
lastRow1 = [Link]([Link], "A").End(xlUp).Row
lastRow2 = [Link]([Link], "A").End(xlUp).Row
' Create a dictionary to store Session IDs from RESPONSE
Set dict = CreateObject("[Link]")
For Each cell In [Link]("A2:A" & lastRow2)
dict([Link]) = True
Next cell
' Create a new sheet for results
On Error Resume Next
[Link] = False
Worksheets("Missing Data").Delete
[Link] = True
On Error GoTo 0
Set resultSheet = [Link]
[Link] = "Missing Data"
' Write header
[Link]("A1").Value = "Session ID"
[Link]("B1").Value = "Amount"
[Link]("C1").Value = "Service Charge"
' Check for missing IDs in RESPONSE
Dim resultRow As Long
resultRow = 2
For Each cell In [Link]("A2:A" & lastRow1)
If Not [Link]([Link]) Then
[Link](resultRow, 1).Value = [Link]
[Link](resultRow, 2).Value = [Link]([Link], 2).Value
[Link](resultRow, 3).Value = [Link]([Link], 3).Value
resultRow = resultRow + 1
End If
Next cell
' Sort results by Amount (Column B) in descending order
With [Link]
.[Link]
.[Link] Key:=[Link]("B2:B" & resultRow - 1), _
SortOn:=xlSortOnValues, Order:=xlDescending,
DataOption:=xlSortNormal
.SetRange [Link]("A1:C" & resultRow - 1)
.Header = xlYes
.Apply
End With
MsgBox "Comparison complete. Missing data saved to 'Missing Data' sheet.",
vbInformation
End Sub