0% found this document useful (0 votes)
2 views2 pages

Excel VBA: Find Missing Data in Sheets

The provided VBA macro compares two worksheets, 'Sheet1' and 'RESPONSE', to identify missing Session IDs from 'RESPONSE'. It creates a new worksheet named 'Missing Data' to list the missing IDs along with their corresponding Amount and Service Charge, and sorts the results by Amount in descending order. A message box is displayed upon completion of the comparison.
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
2 views2 pages

Excel VBA: Find Missing Data in Sheets

The provided VBA macro compares two worksheets, 'Sheet1' and 'RESPONSE', to identify missing Session IDs from 'RESPONSE'. It creates a new worksheet named 'Missing Data' to list the missing IDs along with their corresponding Amount and Service Charge, and sorts the results by Amount in descending order. A message box is displayed upon completion of the comparison.
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd

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

You might also like