Untitled
Greg
plain_text
6 months ago
4.4 kB
5
Indexable
Sub PairOffExceptions() Dim reconWorkbook As Workbook Dim transactionsSheet As Worksheet Dim exceptionsSheet As Worksheet Dim transactionsRow As Long Dim exceptionsRow As Long Dim firstBlankRow As Long Dim cusip As String Dim amount As Double Dim matchFound As Boolean Dim tolerance As Double Dim i As Long, j As Long ' Set tolerance for amount comparison tolerance = 0.02 ' Assuming you are in the recon workbook Set reconWorkbook = ThisWorkbook Set transactionsSheet = reconWorkbook.Sheets("transactions") Set exceptionsSheet = reconWorkbook.Sheets("exceptions") ' Start checking for 6QFG in transactions transactionsRow = transactionsSheet.Cells(transactionsSheet.Rows.Count, 1).End(xlUp).Row For i = 2 To transactionsRow If transactionsSheet.Cells(i, 1).Value = "6QFG" Then cusip = transactionsSheet.Cells(i, 4).Value ' Column D amount = transactionsSheet.Cells(i, 6).Value ' Column F ' Check for matches in RUSECP transactions matchFound = False For j = 2 To transactionsRow If transactionsSheet.Cells(j, 1).Value = "RUSECP" Then If transactionsSheet.Cells(j, 4).Value = cusip And _ Abs(transactionsSheet.Cells(j, 6).Value - amount) <= tolerance Then matchFound = True Exit For End If End If Next j If Not matchFound Then ' Check exceptions for match exceptionsRow = exceptionsSheet.Cells(exceptionsSheet.Rows.Count, 1).End(xlUp).Row For j = 2 To exceptionsRow If exceptionsSheet.Cells(j, 5).Value = cusip And _ exceptionsSheet.Cells(j, 6).Value = amount Then exceptionsSheet.Rows(j).Delete ' Remove matching exception Exit For End If Next j ' Add to exceptions if no match found firstBlankRow = exceptionsSheet.Cells(exceptionsSheet.Rows.Count, 1).End(xlUp).Row + 1 exceptionsSheet.Cells(firstBlankRow, 1).Value = "New Exception" ' Change as needed exceptionsSheet.Cells(firstBlankRow, 5).Value = cusip exceptionsSheet.Cells(firstBlankRow, 6).Value = amount End If End If Next i ' Now check for RUSECP transactions For i = 2 To transactionsRow If transactionsSheet.Cells(i, 1).Value = "RUSECP" Then cusip = transactionsSheet.Cells(i, 4).Value ' Column D amount = transactionsSheet.Cells(i, 6).Value ' Column F ' Check for matches in 6QFG transactions matchFound = False For j = 2 To transactionsRow If transactionsSheet.Cells(j, 1).Value = "6QFG" Then If transactionsSheet.Cells(j, 4).Value = cusip And _ Abs(transactionsSheet.Cells(j, 6).Value - amount) <= tolerance Then matchFound = True Exit For End If End If Next j If Not matchFound Then ' Check exceptions for match exceptionsRow = exceptionsSheet.Cells(exceptionsSheet.Rows.Count, 1).End(xlUp).Row For j = 2 To exceptionsRow If exceptionsSheet.Cells(j, 5).Value = cusip And _ exceptionsSheet.Cells(j, 6).Value = amount Then exceptionsSheet.Rows(j).Delete ' Remove matching exception Exit For End If Next j ' Add to exceptions if no match found firstBlankRow = exceptionsSheet.Cells(exceptionsSheet.Rows.Count, 1).End(xlUp).Row + 1 exceptionsSheet.Cells(firstBlankRow, 1).Value = "New Exception" ' Change as needed exceptionsSheet.Cells(firstBlankRow, 5).Value = cusip exceptionsSheet.Cells(firstBlankRow, 6).Value = amount End If End If Next i MsgBox "Pairing off exceptions complete!", vbInformation End Sub
Editor is loading...
Leave a Comment