Untitled

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