KEMBAR78
Macro Code | PDF
Scribd
Upload
6 views2 pages

Macro Code

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.

Uploaded by

Mogbolahan Folarin
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
6 views2 pages

Macro Code

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.

Uploaded by

Mogbolahan Folarin
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
You are on page 1/ 2

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 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("RESPONSE")

' Find the last rows


lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

' Create a dictionary to store Session IDs from RESPONSE


Set dict = CreateObject("Scripting.Dictionary")
For Each cell In ws2.Range("A2:A" & lastRow2)
dict(cell.Value) = True
Next cell

' Create a new sheet for results


On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Missing Data").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set resultSheet = ThisWorkbook.Sheets.Add
resultSheet.Name = "Missing Data"

' Write header


resultSheet.Range("A1").Value = "Session ID"
resultSheet.Range("B1").Value = "Amount"
resultSheet.Range("C1").Value = "Service Charge"

' Check for missing IDs in RESPONSE


Dim resultRow As Long
resultRow = 2
For Each cell In ws1.Range("A2:A" & lastRow1)
If Not dict.exists(cell.Value) Then
resultSheet.Cells(resultRow, 1).Value = cell.Value
resultSheet.Cells(resultRow, 2).Value = ws1.Cells(cell.Row, 2).Value
resultSheet.Cells(resultRow, 3).Value = ws1.Cells(cell.Row, 3).Value
resultRow = resultRow + 1
End If
Next cell

' Sort results by Amount (Column B) in descending order


With resultSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=resultSheet.Range("B2:B" & resultRow - 1), _
SortOn:=xlSortOnValues, Order:=xlDescending,
DataOption:=xlSortNormal
.SetRange resultSheet.Range("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