Sub Clear_ReconSheetsExtraction()
Dim LR As Long, I As Long
For I = Worksheets("PL Recon Items").Index To Worksheets.Count
With Worksheets(I)
LR = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("a2:M" & LR).ClearContents
End With
Next I
End Sub
Sub ReconItemsList()
Clear_ReconSheetsExtraction
Dim r As Range, arr(), k&, dic As Object
Set dic = CreateObject("scripting.dictionary")
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(, 4).Value2) Then
.Add r.Value2 & "|" & r.Offset(, 4).Value2, r.Value2 & "|" & r.Offset(, 4).Value2
End If
Next r
For Each r In Sheets("Statement Current Month").Range("A2:A" & Sheets("Statement Current Month").Cells(Rows.Count, "A").End(xlUp).Row)
If Not .exists(r.Value2 & "|" & r.Offset(, 1).Value2) And Not dic.exists(r.Value2 & "|" & r.Offset(, 3).Value2) Then
ReDim Preserve arr(4, k)
arr(1, k) = r.Value2
arr(2, k) = r.Offset(, 1).Value2
arr(3, k) = r.Offset(, 2).Value2
arr(4, k) = r.Offset(, 2).Value2
k = k + 1
ElseIf .exists(r.Value2 & "|" & r.Offset(, 1).Value2) And dic.exists(r.Value2 & "|" & r.Offset(, 3).Value2) Then
ReDim Preserve arr(4, k)
arr(1, k) = r.Value2
arr(2, k) = r.Offset(, 1).Value2
arr(3, k) = r.Offset(, 2).Value2
arr(4, k) = r.Offset(, 2).Value2
k = k + 1
ElseIf .exists(r.Value2 & "|" & r.Offset(, 1).Value2) And Not dic.exists(r.Value2 & "|" & r.Offset(, 1).Value2) Then
If Not dic.exists(r.Value2 & "|" & r.Offset(, 1).Value2) Then
dic.Add r.Value2 & "|" & r.Offset(, 1).Value2, r.Value2 & "|" & r.Offset(, 1).Value2
End If
End If
Next r
End With
With Sheets("Statement Recon Items")
On Error Resume Next
.UsedRange.Offset(1).EntireRow.Delete
.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
dic.RemoveAll
With CreateObject("scripting.dictionary")
For Each r In Sheets("Statement Current Month").Range("A2:A" & Sheets("Statement").Cells(Rows.Count, "A").End(xlUp).Row)
If Not .exists(r.Value2 & "|" & r.Offset(, 3).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(, 4).Value2) And Not dic.exists(r.Value2 & "|" & r.Offset(, 4).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
ElseIf .exists(r.Value2 & "|" & r.Offset(, 3).Value2) And dic.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
ElseIf .exists(r.Value2 & "|" & r.Offset(, 3).Value2) And Not dic.exists(r.Value2 & "|" & r.Offset(, 3).Value2) Then
If Not dic.exists(r.Value2 & "|" & r.Offset(, 4).Value2) Then
dic.Add r.Value2 & "|" & r.Offset(, 4).Value2, r.Value2 & "|" & r.Offset(, 4).Value2
End If
End If
Next r
End With
With Sheets("PL Recon Items")
On Error Resume Next
.UsedRange.Offset(1).EntireRow.Delete
.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
dic.RemoveAll
End Sub
Bookmarks