Extract Reconciling Items

[Howardc1001]

I have a sheet called Statement and a and sheet called Purchase Ledger


I have writen code to compare the Reference Number in Col F and Value in Col G on sheet "Statement" with Col F and I on sheet "Purchase Ledger"

Where items on sheet " Statement" does not match sheet Purchase Ledger, then extract to sheet "Statement Reconciling Items"

Where items on sheet "Purchase Ledger" does not match sheet "Statement", then extract to sheet "Purchase Ledger Reconciling Items"


I have manually extracted the data


It would be appreciated if someome could kindly amend my code as it is not extracting the data correctly

 Sub ReconItemsList()
Dim r As Range, arr(), k&
With CreateObject("scripting.dictionary")
    For Each r In Sheets("Purchase Ledger").Range("f2:f" & Sheets("Purchase Ledger").Cells(Rows.Count, "f").End(xlUp).Row)
        If Not .exists(r.Value2 & "|" & r.Offset(, 3).Value2) Then
            .Add r.Value2 & "|" & r.Offset(, 3).Value2, r.Value2 & "|" & r.Offset(, 3).Value2
        End If
    Next r
    
    For Each r In Sheets("Statement").Range("f2:f" & Sheets("Statement").Cells(Rows.Count, "f").End(xlUp).Row)
        If Not .exists(r.Value2 & "|" & r.Offset(, 1).Value2) Then
            ReDim Preserve arr(8, k)
            arr(0, k) = r.Offset(, -5).Value2 '(5 cols back from Starting Col F)
            arr(1, k) = r.Offset(, -4).Value2
            arr(2, k) = r.Offset(, -3).Value2
            arr(3, k) = r.Offset(, -2).Value2
            arr(4, k) = r.Offset(, -1).Value2
            arr(5, k) = r.Value2
            arr(6, k) = r.Offset(, 1).Value2
            arr(7, k) = r.Offset(, 2).Value2
            k = k + 1
        End If
    Next r
End With
With Sheets("Statement Recon Items")
On Error Resume Next

    .Range("a2").Resize(UBound(arr, 2) + 1, UBound(arr, 1) + 1).Value = Application.Transpose(arr)
    .UsedRange.Borders.LineStyle = xlContinuous
    .UsedRange.Columns.AutoFit
End With
Erase arr

k = 0
With CreateObject("scripting.dictionary")
    For Each r In Sheets("Statement").Range("f2:f" & Sheets("Statement").Cells(Rows.Count, "f").End(xlUp).Row)
        If Not .exists(r.Value2 & "|" & r.Offset(, 1).Value2) Then
            .Add r.Value2 & "|" & r.Offset(, 1).Value2, r.Value2 & "|" & r.Offset(, 1).Value2
        End If
    Next r
    
    For Each r In Sheets("Purchase Ledger").Range("f2:f" & Sheets("Purchase Ledger").Cells(Rows.Count, "f").End(xlUp).Row)
        If Not .exists(r.Value2 & "|" & r.Offset(, 3).Value2) Then
            ReDim Preserve arr(11, k)
            arr(0, k) = r.Offset(, -5).Value2 '(5 cols back from Starting Col F)
            arr(1, k) = r.Offset(, -4).Value2
            arr(2, k) = r.Offset(, -3).Value2
            arr(3, k) = r.Offset(, -2).Value2
            arr(4, k) = r.Offset(, -1).Value2
            arr(5, k) = r.Value2
            arr(6, k) = r.Offset(, 1).Value2
            arr(7, k) = r.Offset(, 2).Value2
            arr(8, k) = r.Offset(, 3).Value2
            arr(9, k) = r.Offset(, 4).Value2
            arr(10, k) = r.Offset(, 5).Value2
            k = k + 1
        End If
    Next r
End With
With Sheets("PL Recon Items")
    .Range("a2").Resize(UBound(arr, 2) + 1, UBound(arr, 1) + 1).Value = Application.Transpose(arr)
    .UsedRange.Borders.LineStyle = xlContinuous
    .UsedRange.Columns.AutoFit
End With
Erase arr

End Sub