Untitled

 avatar
Greg
plain_text
6 months ago
5.5 kB
6
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 Sub
Editor is loading...
Leave a Comment