Untitled

Sub PairOffExceptions()
    Dim reconWorkbook As Workbook
    Dim exceptionsSheet As Worksheet
    Dim transactionsSheet As Worksheet
    Dim exceptionList As Collection
    Dim transactionList As Collection
    Dim transactionRow As Long
    Dim exceptionRow As Long
    Dim lastExceptionRow As Long
    Dim lastTransactionRow As Long
    Dim currentTransaction As Variant
    Dim i As Long, j As Long
    Dim offsetTolerance As Double
    Dim addedToExceptions As Boolean
    
    ' Initialize workbook and sheets
    Set reconWorkbook = ThisWorkbook
    Set exceptionsSheet = reconWorkbook.Sheets("exceptions")
    Set transactionsSheet = reconWorkbook.Sheets("transactions")
    
    ' Initialize collections for in-memory storage
    Set exceptionList = New Collection
    Set transactionList = New Collection
    
    ' Define offset tolerance
    offsetTolerance = 0.02
    
    ' Load transactions into memory, storing CUSIP, amount, source, and a flag to track processing status
    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 As Variant
            transData = Array(transactionsSheet.Cells(transactionRow, "A").Value, _
                              transactionsSheet.Cells(transactionRow, "D").Value, _
                              transactionsSheet.Cells(transactionRow, "F").Value, _
                              transactionsSheet.Cells(transactionRow, "B").Value, _  ' Source
                              False) ' Processed flag, initially set to False
            transactionList.Add transData
        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 As Variant
        excData = Array(exceptionsSheet.Cells(exceptionRow, "A").Value, _
                        exceptionsSheet.Cells(exceptionRow, "E").Value, _
                        exceptionsSheet.Cells(exceptionRow, "F").Value)
        exceptionList.Add excData
    Next exceptionRow

    ' Iterate through transactions in memory to find pairs
    For i = 1 To transactionList.Count
        addedToExceptions = True
        currentTransaction = transactionList(i)

        ' Skip if already processed
        If currentTransaction(4) = True Then
            GoTo NextTransaction
        End If

        ' Step 1: Check for offsetting transaction in transactionList
        For j = i + 1 To transactionList.Count
            Dim compareTransaction As Variant
            compareTransaction = transactionList(j)
            
            If Not compareTransaction(4) Then ' Only consider unprocessed items
                If currentTransaction(1) = compareTransaction(1) And Abs(currentTransaction(2) + compareTransaction(2)) <= offsetTolerance Then
                    ' Offset found, check if sources are different ("Reams" and "BK")
                    If currentTransaction(3) <> compareTransaction(3) Then
                        transactionList(i)(4) = True ' Mark current as processed
                        transactionList(j)(4) = True ' Mark offsetting as processed
                        addedToExceptions = False
                        Exit For ' Exit the offsetting transaction check if matched
                    End If
                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
            Dim compareException As Variant
            compareException = exceptionList(j)
            
            If currentTransaction(1) = compareException(1) And Abs(currentTransaction(2) - compareException(2)) <= offsetTolerance Then
                transactionList(i)(4) = True ' Mark as processed
                ' Remove matching exception from the exceptions tab
                Dim excRowToRemove As Long
                excRowToRemove = j + 1 ' Adjust for header row
                exceptionsSheet.Rows(excRowToRemove).Delete ' Delete row from exceptions sheet
                addedToExceptions = False
                Exit For ' Exit the exceptions check if matched
            End If
        Next j

        ' Step 3: Add unmatched transactions to exceptions
        If addedToExceptions Then
            With exceptionsSheet
                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)
                ' Additional columns if needed for A-H
            End With
        End If
NextTransaction:
    Next i

    MsgBox "Exception pairing complete!", vbInformation
End Sub