Untitled
Greg
plain_text
6 months ago
6.6 kB
7
Indexable
Sub PairOffExceptions() Dim reconWorkbook As Workbook Dim exceptionsSheet As Worksheet Dim transactionsSheet As Worksheet Dim exceptionList As Collection Dim transactionList As Collection Dim processedFlags As Collection Dim transactionRow As Long Dim exceptionRow As Long Dim lastExceptionRow As Long Dim lastTransactionRow As Long Dim currentTransaction As Variant Dim compareTransaction As Variant Dim compareException As Variant Dim i As Long, j As Long Dim offsetTolerance As Double Dim addedToExceptions As Boolean ' Initialize workbook and sheets Set reconWorkbook = ThisWorkbook On Error Resume Next ' Ignore errors temporarily Set exceptionsSheet = reconWorkbook.Sheets("exceptions") Set transactionsSheet = reconWorkbook.Sheets("transactions") On Error GoTo 0 ' Resume normal error handling ' Check if sheets are set correctly If exceptionsSheet Is Nothing Or transactionsSheet Is Nothing Then MsgBox "One or both of the sheets 'exceptions' or 'transactions' do not exist.", vbCritical Exit Sub End If ' Initialize collections for in-memory storage Set exceptionList = New Collection Set transactionList = New Collection Set processedFlags = New Collection ' Collection to track processed transactions ' Define offset tolerance offsetTolerance = 0.02 ' Load transactions into memory, storing all relevant info (Columns A-H) 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 7) As Variant ' Declare an array for Columns A-H transData(0) = transactionsSheet.Cells(transactionRow, "A").Value ' Column A transData(1) = transactionsSheet.Cells(transactionRow, "B").Value ' Column B transData(2) = transactionsSheet.Cells(transactionRow, "C").Value ' Column C transData(3) = transactionsSheet.Cells(transactionRow, "D").Value ' Column D (CUSIP) transData(4) = transactionsSheet.Cells(transactionRow, "E").Value ' Column E transData(5) = transactionsSheet.Cells(transactionRow, "F").Value ' Column F (Amount) transData(6) = transactionsSheet.Cells(transactionRow, "G").Value ' Column G transData(7) = transactionsSheet.Cells(transactionRow, "H").Value ' Column H transactionList.Add transData ' Add the array to the transaction list processedFlags.Add False ' Add a corresponding flag for processed status End If Next transactionRow ' Load existing exceptions into memory lastExceptionRow = exceptionsSheet.Cells(exceptionsSheet.Rows.Count, "A").End(xlUp).Row For exceptionRow = 2 To lastExceptionRow Dim excData(0 To 7) As Variant ' Declare an array for Columns A-H excData(0) = exceptionsSheet.Cells(exceptionRow, "A").Value ' Column A excData(1) = exceptionsSheet.Cells(exceptionRow, "B").Value ' Column B excData(2) = exceptionsSheet.Cells(exceptionRow, "C").Value ' Column C excData(3) = exceptionsSheet.Cells(exceptionRow, "D").Value ' Column D (CUSIP) excData(4) = exceptionsSheet.Cells(exceptionRow, "E").Value ' Column E excData(5) = exceptionsSheet.Cells(exceptionRow, "F").Value ' Column F (Amount) excData(6) = exceptionsSheet.Cells(exceptionRow, "G").Value ' Column G excData(7) = exceptionsSheet.Cells(exceptionRow, "H").Value ' Column H exceptionList.Add excData ' Add the array to the exception list Next exceptionRow ' Iterate through transactions in memory to find pairs For i = 1 To transactionList.Count addedToExceptions = True currentTransaction = transactionList(i) ' Step 1: Check for offsetting transaction in transactionList For j = i + 1 To transactionList.Count compareTransaction = transactionList(j) If Not processedFlags(i) And Not processedFlags(j) Then If currentTransaction(3) = compareTransaction(3) And Abs(currentTransaction(5) + compareTransaction(5)) <= offsetTolerance Then ' Offset found, mark both as processed processedFlags(i) = True ' Mark as processed processedFlags(j) = True ' Mark the paired transaction as processed addedToExceptions = False Exit For End If End If Next j ' Skip to next transaction if offsetting match was found If Not addedToExceptions Then GoTo NextTransaction End If ' Step 2: Check for matching entry in exceptionsList For j = 1 To exceptionList.Count compareException = exceptionList(j) If Not processedFlags(i) Then If currentTransaction(3) = compareException(3) And Abs(currentTransaction(5) - compareException(5)) <= offsetTolerance Then ' Remove matching exception from the exceptions tab exceptionsSheet.Rows(j + 1).Delete ' Delete row from exceptions sheet addedToExceptions = False Exit For End If End If Next j ' Step 3: Add unmatched transactions to exceptions with all info from columns A-H If addedToExceptions Then With exceptionsSheet lastExceptionRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 .Cells(lastExceptionRow, "A").Value = currentTransaction(0) ' Column A .Cells(lastExceptionRow, "B").Value = currentTransaction(1) ' Column B .Cells(lastExceptionRow, "C").Value = currentTransaction(2) ' Column C .Cells(lastExceptionRow, "D").Value = currentTransaction(3) ' Column D (CUSIP) .Cells(lastExceptionRow, "E").Value = currentTransaction(4) ' Column E .Cells(lastExceptionRow, "F").Value = currentTransaction(5) ' Column F (Amount) .Cells(lastExceptionRow, "G").Value = currentTransaction(6) ' Column G .Cells(lastExceptionRow, "H").Value = currentTransaction(7) ' Column H End With End If NextTransaction: Next i MsgBox "Exception pairing complete!", vbInformation End Sub
Editor is loading...
Leave a Comment