Untitled
Greg
plain_text
a year ago
5.5 kB
7
Indexable
Sub PairOffExceptions()
Dim reconWorkbook As Workbook
Dim exceptionsSheet As Worksheet
Dim transactionsSheet As Worksheet
Dim transactionList As Collection
Dim lastTransactionRow As Long
Dim transactionRow As Long
Dim currentTransaction As Variant
Dim compareTransaction As Variant
Dim offsetTolerance As Double
Dim addedToExceptions As Boolean
Dim i As Long, j As Long
' Initialize workbook and sheets
Set reconWorkbook = ThisWorkbook
Set exceptionsSheet = reconWorkbook.Sheets("exceptions")
Set transactionsSheet = reconWorkbook.Sheets("transactions")
' Initialize collections for in-memory storage
Set transactionList = New Collection
' Define offset tolerance
offsetTolerance = 0.02
' Load transactions into memory, filtering by '6QFG' or 'RUSECP'
lastTransactionRow = transactionsSheet.Cells(transactionsSheet.Rows.Count, "A").End(xlUp).Row
For transactionRow = 2 To lastTransactionRow
If transactionsSheet.Cells(transactionRow, "A").Value = "6QFG" Or transactionsSheet.Cells(transactionRow, "A").Value = "RUSECP" Then
Dim transData(0 To 4) As Variant ' Array to store transaction details
transData(0) = transactionsSheet.Cells(transactionRow, "A").Value ' Column A (Transaction ID)
transData(1) = transactionsSheet.Cells(transactionRow, "D").Value ' Column D (CUSIP)
transData(2) = transactionsSheet.Cells(transactionRow, "F").Value ' Column F (Amount)
transData(3) = transactionsSheet.Cells(transactionRow, "B").Value ' Column B (Source)
transData(4) = False ' Processed flag, initially set to False
transactionList.Add transData ' Add the transaction to the list
End If
Next transactionRow
' Iterate through transactions in memory to find pairs
For i = 1 To transactionList.Count
currentTransaction = transactionList(i)
' Step 1: Skip if already processed
If currentTransaction(4) = True Then GoTo NextTransaction
addedToExceptions = True ' Assume it will be added to exceptions unless matched
' Step 2: Check for offsetting transaction in transactionList
For j = i + 1 To transactionList.Count
compareTransaction = transactionList(j)
' Only consider unprocessed items
If compareTransaction(4) = False Then
If currentTransaction(1) = compareTransaction(1) And _
Abs(currentTransaction(2) + compareTransaction(2)) <= offsetTolerance Then
' Offset found, mark both as processed
transactionList(i)(4) = True
transactionList(j)(4) = True
addedToExceptions = False ' Not added to exceptions
Exit For
End If
End If
Next j
' Step 3: Check for equal transaction in the same list if sources are different
If addedToExceptions Then
For j = 1 To transactionList.Count
compareTransaction = transactionList(j)
If compareTransaction(4) = False And i <> j Then ' Not the same transaction
If currentTransaction(1) = compareTransaction(1) And _
Abs(currentTransaction(2) - compareTransaction(2)) <= offsetTolerance And _
currentTransaction(3) <> compareTransaction(3) Then
' Equal found with different source
transactionList(i)(4) = True
transactionList(j)(4) = True
addedToExceptions = False ' Not added to exceptions
Exit For
End If
End If
Next j
End If
' Step 4: Only check exceptions if the transaction was not paired off
If addedToExceptions Then
Dim currentExceptionRow As Long
currentExceptionRow = exceptionsSheet.Cells(exceptionsSheet.Rows.Count, "A").End(xlUp).Row
For j = 2 To currentExceptionRow
If exceptionsSheet.Cells(j, "D").Value = currentTransaction(1) And _
Abs(exceptionsSheet.Cells(j, "F").Value - currentTransaction(2)) <= offsetTolerance Then
' Equal found in exceptions
exceptionsSheet.Rows(j).Delete ' Delete matching exception row
transactionList(i)(4) = True ' Mark current as processed
addedToExceptions = False ' Not added to exceptions
Exit For
End If
Next j
End If
' Step 5: If still unmatched, add to exceptions
If addedToExceptions Then
With exceptionsSheet
Dim lastExceptionRow As Long
lastExceptionRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lastExceptionRow, "A").Value = currentTransaction(0) ' Column A
.Cells(lastExceptionRow, "D").Value = currentTransaction(1) ' Column D (CUSIP)
.Cells(lastExceptionRow, "F").Value = currentTransaction(2) ' Column F (Amount)
.Cells(lastExceptionRow, "B").Value = currentTransaction(3) ' Column B (Source)
' Copy additional columns from A-H if necessary
End With
End If
NextTransaction:
Next i
MsgBox "Exception pairing complete!", vbInformation
End SubEditor is loading...
Leave a Comment