Add new workbook with name of "Key"
Sheet Name "Input"
Go to Developer and insert Module
and copy paste below code
'************************************************
Option ExplicitSub t()
Dim wkb As Workbook
Dim wks As Worksheet
Dim i As Long
Dim i2 As Long
Dim pth As String
Dim sfdr As String
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets("Input")
pth = ThisWorkbook.Path
i = wks.Cells(Rows.Count, 1).End(xlUp).Row
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
sfdr = .SelectedItems(1)
End If
End With
'*****************************************************************************************
'f1 working
Workbooks.Open sfdr & "\" & wks.Range("C2")
Dim wkb1 As Workbook
Dim wks1 As Worksheet
Dim L1 As Long
Dim C1 As Long
Set wkb1 = ActiveWorkbook
Set wks1 = wkb1.Sheets(1)
L1 = wks1.Cells(Rows.Count, 2).End(xlUp).Row
C1 = wks1.Cells(1, Columns.Count).End(xlToLeft).Column
With wks1
.Range("A:A").Insert
.Range("A1").Value = "key"
.Range("A2").Value = "=LEFT(C2,4)&B2"
.Range("A2").Copy
.Range("A3:A" & L1).Select
.Range("A3:A" & L1).PasteSpecial (xlPasteAll)
.Range("A2:A" & L1).Copy
.Range("A3:A" & L1).PasteSpecial xlPasteValuesAndNumberFormats
.Range("A" & C1).Value = "Post Rule"
.Range("A" & C1 + 1).Value = "PRule"
.Range("A" & C1 + 2).Value = "memoLine"
End With
'Re-count column as new col was added
C1 = wks1.Cells(1, Columns.Count).End(xlToLeft).Column
wks1.Range(Cells(1, 1), Cells(1, C1)).Select
'wks1.Range(Cells(1, 1), Cells(1, C1)).Sort key1,xlAscending
'*****************************************************************************************
'f2 working
Workbooks.Open sfdr & "\" & wks.Range("C3")
Dim wkb2 As Workbook
Dim wks2 As Worksheet
Dim L2 As Long
Dim C2 As Long
Set wkb2 = ActiveWorkbook
Set wks2 = wkb2.Sheets(1)
L2 = wks2.Cells(Rows.Count, 2).End(xlUp).Row
C2 = wks2.Cells(1, Columns.Count).End(xlToLeft).Column
With wks2
.Range("A:A").Insert
.Range("A1").Value = "key"
.Range("A2").Value = "=LEFT(C2,4)&B2"
.Range("A2").Copy
.Range("A3:A" & L1).Select
.Range("A3:A" & L1).PasteSpecial (xlPasteAll)
.Range("A2:A" & L1).Copy
.Range("A3:A" & L1).PasteSpecial xlPasteValuesAndNumberFormats
End With
C2 = wks2.Cells(1, Columns.Count).End(xlToLeft).Column
'***********************************************************************
'Update Memo line in bank open item
Dim a1 As Long 'using in open item
Dim a2 As Long ' using in bank reprocess line
For a2 = 2 To L2
For a1 = 2 To L1
If wks2.Range("A" & a2).Value = wks1.Range("A" & a1).Value Then
If wks1.Range("C" & a1).Value = "ZR" Then
wks1.Cells(a1, C1 - 2) = wks2.Cells(a2, C2 - 2)
wks1.Cells(a1, C1 - 1) = wks2.Cells(a2, C2 - 1)
wks1.Cells(a1, C1 - 0) = wks2.Cells(a2, C2 - 0)
Exit For
End If
End If
End If
Next a1
Next a2
End Sub
*********END of Code**************************
0 Comments