Code to Customize Bank statement

[RAJESH1960]

Hello Experts

I have this code which customizes bank statement as I want it to be. This code works for one particular bank only. AS there are N number of banks and the format and heading of each bank is different, I am not able to edit the code accordingly. AS the code was shared without comments, I don’t have any idea what some of the lines in the code actually do. The code in the VBA editor window works for the bank hidden in the workbook only. There is another code which is to be included in this bank code which combines text of multiple rows at each change in date. I need your expertise to edit both the codes wherever required and get the result as shown in the expected result sheet. I request you to please add a comment at line of code so that I can create multiple apps depending on each bank.
The sheet Bank is the original form as and when the data is received. I need the code for this sheet and get the result as in sheet Expected Result.
P.S: The code in the visual basic is only for reference purpose as it will help to solve more than 50% of the work. To test the code Bank Clean Data in the workbook you have to unhide the bank and name it as Bank.Customize New Bank.xlsm

 

[johnnyL]

I would check the date column for non date entries and delete the row(s) that are not dates.

 

[johnnyL]

How about in this line....

    InputArray = ws2.Range(DateColumnLetter & StartRow & ":" & ConCatColumnLetter & _
            ws2.Range(ConCatColumnLetter & Rows.Count).End(xlUp).Row).Value2        ' Save data from sheet into InputArray

I'm not sure if it would work there because I don't know the rest of your code. Even if you did find a spot to put the '-1', you are guessing that you will always want to 'skip' the last row of data.

 

[RAJESH1960]

The following code will create the new sheet, copy the 'Bank' sheet to it, & then do any text joining, followed by deleting all of the blank rows that remain after that.

From that point you can run code on the new sheet instead of the original 'Bank' sheet:

Option Explicit

Sub ConcatTestV2()                                                                  ' For Bank statements
'
'solved by JohnnyL 24-06-2022
'works in the sheet which is open

    Dim ArrayRow                As Long, OutputRow          As Long
    Dim BlankRows               As Long, CurrentRow         As Long
    Dim StartRow                As Long
    Dim ConCatColumnLetter      As String
    Dim DateColumnLetter        As String
    Dim sname                   As String
    Dim InputArray              As Variant, OutputArray()   As Variant
    Dim ws1                     As Worksheet, ws2           As Worksheet
'
    Set ws1 = Worksheets("New Bank")                                                ' <-- Set this to the sheet to use for the input data
'
    ConCatColumnLetter = "B"                                                        ' <--- Set this to column that needs Concat function
    DateColumnLetter = "A"                                                          ' <--- Set this to column of Dates
    sname = "BankData"                                                              ' <--- Set this to the new sheet name
    StartRow = 2                                                                    ' <--- Set this to the starting row of data
'
    Sheets.Add(After:=ws1).Name = sname                                             ' Add new sheet after the sheet used for the input
    Set ws2 = Worksheets(sname)                                                     ' Set ws2 to the sheet to use for the output data
'
    ws1.UsedRange.Copy ws2.Range("A1")                                              ' Copy Source sheet to new sheet
'
    InputArray = ws2.Range(DateColumnLetter & StartRow & ":" & ConCatColumnLetter & _
            ws2.Range(ConCatColumnLetter & Rows.Count).End(xlUp).Row).Value2        ' Save data from sheet into InputArray
    ReDim OutputArray(1 To UBound(InputArray, 1), 1 To UBound(InputArray, 2))       ' Set OutputArray to same # of rows & columns as the InputArray
'
    BlankRows = 0                                                                   ' Initialize BlankRows
    OutputRow = 0                                                                   ' Initialize OutputRow
'
    For ArrayRow = 1 To UBound(InputArray, 1)                                       ' Loop through the rows of the InputArray
        If InputArray(ArrayRow, 1) <> vbNullString Then                             '   If Date is not blank then ...
            OutputRow = OutputRow + 1                                               '       Increment OutputRow
'
            CurrentRow = OutputRow + BlankRows                                      '       Get total of OutputRow + BlankRows and save to CurrentRow
            OutputArray(CurrentRow, 1) = InputArray(ArrayRow, 2)                    '       Save Concat word to OutputArray(CurrentRow, 1)
        Else                                                                        '   Else ...
            BlankRows = BlankRows + 1                                               '       Increment BlankRows
            OutputArray(CurrentRow, 1) = OutputArray(CurrentRow, 1) & _
                    " " & InputArray(ArrayRow, 2)                                   '       Append a space & next Concat word to OutputArray(CurrentRow, 1)
        End If
    Next                                                                            ' Loop back
'
    With ws2
        .Range(ConCatColumnLetter & StartRow & ":" & ConCatColumnLetter & _
                .Range(ConCatColumnLetter & _
                .Rows.Count).End(xlUp).Row).Value2 = OutputArray                    '   Write Concat column back to new sheet
        .UsedRange.WrapText = False                                                 '   Set WrapText for new sheet to False
        .UsedRange.EntireColumn.AutoFit                                             '   Autofit all used columns in the new sheet
        .UsedRange.EntireRow.AutoFit                                                '   autofit all rows in the new sheet
'
        On Error Resume Next                                                        '   Ignore error in next line if no blank rows were found to delete
        .Columns("A").SpecialCells(xlBlanks).EntireRow.Delete                       '
    End With
End Sub

It is this code which you shared yesterday which needs to be edited.

 

[johnnyL]

If you were strictly running that code, yes, a '-1' in that line would not load the last row into the array.

 

[RAJESH1960]

If you were strictly running that code, yes, a '-1' in that line would not load the last row into the array.

I tried placing -1 in many areas of the line but was not able to avoid the last row.

 

[johnnyL]

If that last line of data is already on your sheet then a '-1' in the code to join is not gonna fix that.

 

[RAJESH1960]

Rows.Count).End(xlUp).Row-1 means one row less right.

 

[RAJESH1960]

Maybe you should define a new variable as Dim LastRow as.....??

 

[johnnyL]

Rows.Count).End(xlUp).Row-1 means one row less right.

Yes

 

[johnnyL]

@johnnyL steps up to the plate, he points with his bat towards the left field fence. He awaits the pitch and then swings:

Option Explicit

Sub Bank_CleanDataV2()
'
'solved by JohnnyL 24-06-2022
'
    Dim ArrayRow                            As Long, OutputRow                              As Long
    Dim BlankRows                           As Long, CurrentRow                             As Long
    Dim SheetRow                            As Long, StartRow                               As Long
'
    Dim OutputClosingBalanceColumnNumber    As Long, OutputDateColumnNumber                 As Long
    Dim OutputDepositAmountColumnNumber     As Long, OutputNarrationColumnNumber            As Long
    Dim OutputLineColumnNumber              As Long, OutputTallyLedgerColumnNumber          As Long
    Dim OutputVoucherTypeColumnNumber       As Long, OutputWithdrawalAmountColumnNumber     As Long
'
    Dim SourceChqRefColumnNumber            As Long, SourceClosingBalanceColumnNumber       As Long
    Dim SourceConCatColumnNumber            As Long, SourceDateColumnNumber                 As Long
    Dim SourceDepositAmountColumnNumber     As Long, SourceWithdrawalAmountColumn           As Long
    Dim SourceNarrationColumnNumber         As Long
'
    Dim OutputCheckColumnLetter             As String, OutputClosingBalanceColumnLetter     As String
    Dim OutputDepositAmountColumnLetter     As String, OutputWithdrawalAmountColumnLetter   As String
    Dim SourceConCatColumnLetter            As String, SourceDateColumnLetter               As String
    Dim LastColumnInSheet                   As String
    Dim NewSheetName                        As String
    Dim HeaderArray                         As Variant, SourceArray                         As Variant, OutputArray()   As Variant
    Dim SourceSheet                         As Worksheet, OutputSheet                       As Worksheet
'
    Set SourceSheet = Worksheets("New Bank")                                        ' <-- Set this to the sheet to use for the input data
'
     OutputCheckColumnLetter = "J"                                                  ' <--- Set this to OutputCheckColumnLetter
    SourceConCatColumnLetter = "B"                                                  ' <--- Set this to the source column that needs Concat function
      SourceDateColumnLetter = "A"                                                  ' <--- Set this to source column of Dates
                NewSheetName = "Bank"                                               ' <--- Set this to the NewSheetName
                    StartRow = 2                                                    ' <--- Set this to the starting row of data
'
      OutputClosingBalanceColumnNumber = 9                                          ' <--- Set this to the OutputClosingBalanceColumnNumber
                OutputDateColumnNumber = 2                                          ' <--- Set this to the OutputDateColumnNumber
       OutputDepositAmountColumnNumber = 7                                          ' <--- Set this to the OutputDepositAmountColumnNumber
                OutputLineColumnNumber = 1                                          ' <--- Set this to the OutputLineColumnNumber
           OutputNarrationColumnNumber = 8                                          ' <--- Set this to the OutputNarrationColumnNumber
         OutputTallyLedgerColumnNumber = 5                                          ' <--- Set this to the OutputTallyLedgerColumnNumber
         OutputVoucherTypeColumnNumber = 3                                          ' <--- Set this to the OutputVoucherTypeColumnNumber
    OutputWithdrawalAmountColumnNumber = 6                                          ' <--- Set this to the OutputWithdrawalAmountColumn
'
            SourceChqRefColumnNumber = 3                                            ' <--- Set this to the SourceChqRefColumnNumber
    SourceClosingBalanceColumnNumber = 7                                            ' <--- Set this to the SourceClosingBalanceColumnNumber
              SourceDateColumnNumber = 1                                            ' <--- Set this to the SourceDateColumnNumber
     SourceDepositAmountColumnNumber = 6                                            ' <--- Set this to the SourceDepositAmountColumnNumber
         SourceNarrationColumnNumber = 2                                            ' <--- Set this to the SourceNarrationColumnNumber
        SourceWithdrawalAmountColumn = 5                                            ' <--- Set this to the SourceWithdrawalAmountColumn
'
    HeaderArray = Array("Line", "Date", "Voucher Type", "Voucher No.", _
            "Tally Ledger Name", "Withdrawal Amt.", "Deposit Amt.", _
            "Narration", "Closing Balance", "Check")                                ' <--- Set Array of headers to write to the created sheet
'
    Application.ScreenUpdating = False                                              ' Turn ScreenUpdating off
'
    Sheets.Add(After:=SourceSheet).Name = NewSheetName                              ' Add new sheet after the sheet used for the input
    Set OutputSheet = Worksheets(NewSheetName)                                      ' Set OutputSheet to the sheet to use for the output data
'
    SourceSheet.UsedRange.Copy OutputSheet.Range("A1")                              ' Copy SourceSheet to OutputSheet
'
    SourceConCatColumnNumber = OutputSheet.Range(SourceConCatColumnLetter & 1).Column   ' Convert SourceConCatColumnLetter to SourceConCatColumnNumber
    SourceDateColumnNumber = OutputSheet.Range(SourceDateColumnLetter & 1).Column   ' Convert SourceDateColumnLetter to SourceDateColumnNumber
'
    LastColumnInSheet = Split(OutputSheet.Cells(1, (OutputSheet.Cells.Find("*", , xlFormulas, , _
            xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last Column Letter used in sheet
'
    BlankRows = 0                                                                   ' Initialize BlankRows
    OutputRow = 0                                                                   ' Initialize OutputRow
'
'-----------------------------------------------------------------------------------
'
    SourceArray = OutputSheet.Range("A" & StartRow & ":" & LastColumnInSheet & _
            OutputSheet.Range(SourceConCatColumnLetter & Rows.Count).End(xlUp).Row).Value2  ' Save data from sheet into SourceArray
    ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To 1)                          ' Set OutputArray to same # of rows as the SourceArray
'
    For ArrayRow = 1 To UBound(SourceArray, 1)                                      ' Loop through the rows of the SourceArray
        If SourceArray(ArrayRow, SourceDateColumnNumber) <> vbNullString Then       '   If Date is not blank then ...
            OutputRow = OutputRow + 1                                               '       Increment OutputRow
'
            CurrentRow = OutputRow + BlankRows                                      '       Get total of OutputRow + BlankRows and save to CurrentRow
            OutputArray(CurrentRow, 1) = SourceArray(ArrayRow, SourceConCatColumnNumber)    '       Save Concat word to OutputArray(CurrentRow, 1)
        Else                                                                        '   Else ...
            BlankRows = BlankRows + 1                                               '       Increment BlankRows
            OutputArray(CurrentRow, 1) = OutputArray(CurrentRow, 1) & _
                    " " & SourceArray(ArrayRow, SourceConCatColumnNumber)           '       Append a space & next Concat word to OutputArray(CurrentRow, 1)
        End If
    Next                                                                            ' Loop back
'
'-----------------------------------------------------------------------------------
'
    With OutputSheet
        .Range(SourceConCatColumnLetter & StartRow & ":" & SourceConCatColumnLetter & _
                .Range(SourceConCatColumnLetter & _
                .Rows.Count).End(xlUp).Row).Value2 = OutputArray                    '   Write Concat column back to new sheet
'
        On Error Resume Next                                                        '   Ignore error in next line if no blank rows were found to delete
        .Columns("A").SpecialCells(xlBlanks).EntireRow.Delete                       '   If cell in used range of column A is blank then delete that row
'
        For SheetRow = .Cells(.Rows.Count, "A").End(xlUp).Row To StartRow Step -1   '   Loop backwards through the rows
            If Not IsDate(.Cells(SheetRow, 1)) Then _
                    .Cells(SheetRow, 1).EntireRow.Delete                            '       If cell in used range of Column A is not a date then delete row
        Next                                                                        '   Loop back
    End With
'
'-----------------------------------------------------------------------------------
'
    SourceArray = OutputSheet.Range("A" & StartRow & ":" & LastColumnInSheet & _
            OutputSheet.Range(SourceDateColumnLetter & Rows.Count).End(xlUp).Row)   ' Load Data from new sheet into SourceArray
    ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(HeaderArray) + 1)    ' Set # of rows & columns for the OutputArray
'
    OutputSheet.UsedRange.Clear                                                     ' Erase the OutputSheet
'
    OutputRow = 0                                                                   ' Reset OutputRow
'
    For ArrayRow = 1 To UBound(SourceArray, 1)                                      ' Loop through the rows of data in the SourceArray
        OutputRow = OutputRow + 1
'
        OutputArray(ArrayRow, OutputLineColumnNumber) = ArrayRow                    '   Save the Line # to Column 1 of OutputArray
        OutputArray(ArrayRow, OutputDateColumnNumber) = _
                SourceArray(ArrayRow, SourceDateColumnNumber)                       '   Save Date to Column 2 of OutputArray
'
' voucher type
        If SourceArray(ArrayRow, SourceWithdrawalAmountColumn) <> 0 Then            '   If Withdrawal Amt. <> 0 then ...
            OutputArray(ArrayRow, OutputVoucherTypeColumnNumber) = "Payment"        '       Put "Payment" in Column 3 of OutputArray
        ElseIf SourceArray(ArrayRow, SourceDepositAmountColumnNumber) <> 0 Then     '   Else if Deposit Amt. <> 0 then ...
            OutputArray(ArrayRow, OutputVoucherTypeColumnNumber) = "Receipt"        '       Put "Receipt" in Column 3 of OutputArray
        End If
'
'voucher #
' ???
'
'
'Tally Ledger Name
' ???
        OutputArray(ArrayRow, OutputTallyLedgerColumnNumber) = "Suspense"           '   Not sure if this is supposed to be hard coded?
'
        OutputArray(ArrayRow, OutputWithdrawalAmountColumnNumber) = _
                SourceArray(ArrayRow, SourceWithdrawalAmountColumn)                 '   Save Withdrawal Amount to Column 6 of OutputArray
        OutputArray(ArrayRow, OutputDepositAmountColumnNumber) = _
                SourceArray(ArrayRow, SourceDepositAmountColumnNumber)              '   Save Deposit Amount to Column 7 of OutputArray
'
        If SourceArray(ArrayRow, SourceChqRefColumnNumber) <> 0 Then                '   If Chq./Ref.No. <> 0 then ...
            OutputArray(ArrayRow, OutputNarrationColumnNumber) = SourceArray(ArrayRow, _
                    SourceNarrationColumnNumber) & " Chq./Ref.No. " & _
                    SourceArray(ArrayRow, SourceChqRefColumnNumber)                 '       Save Narration & Chq./Ref.No. to Column 8 of OutputArray
        Else                                                                        '   Else ...
            OutputArray(ArrayRow, OutputNarrationColumnNumber) = _
                    SourceArray(ArrayRow, SourceNarrationColumnNumber)              '       Save Narration to Column 8 of OutputArray
        End If
'
        OutputArray(ArrayRow, OutputClosingBalanceColumnNumber) = _
                SourceArray(ArrayRow, SourceClosingBalanceColumnNumber)             '   Save Closing Balance to Column 9 of OutputArray
    Next                                                                            ' Loop back
'
'-----------------------------------------------------------------------------------
'
    With OutputSheet
        .Range("A1").Resize(, UBound(HeaderArray) + 1) = HeaderArray                '   Write the array of headers to first row of new sheet
        .Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray   '   Display OutputArray to new sheet starting on row 2
'
        .Columns(OutputDateColumnNumber).NumberFormat = "dd-mm-yyyy"                '   Set Date format of new sheet Column B to "dd-mm-yyyy"
'
        OutputClosingBalanceColumnLetter = Split(.Cells(1, _
                OutputClosingBalanceColumnNumber).Address, "$")(1)                  '   Convert OutputClosingBalanceColumnNumber to OutputClosingBalanceColumnLetter
        OutputDepositAmountColumnLetter = Split(.Cells(1, _
                OutputDepositAmountColumnNumber).Address, "$")(1)                   '   Convert OutputDepositAmountColumnNumber to OutputDepositAmountColumnLetter
        OutputWithdrawalAmountColumnLetter = Split(.Cells(1, _
                OutputWithdrawalAmountColumnNumber).Address, "$")(1)                '   Convert OutputWithdrawalAmountColumnNumber to OutputWithdrawalAmountColumnLetter
'
        With .Columns(OutputWithdrawalAmountColumnLetter & ":" & OutputDepositAmountColumnLetter)
            .NumberFormat = "0.00"                                                  '       Set NumberFormat of Columns F:G on new sheet to 2 decimal places
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
'
        .Range(OutputCheckColumnLetter & StartRow).Formula = "=RC[-1]"              '   Set initial value of 'Check' column (J2)
        .Range(OutputCheckColumnLetter & StartRow + 1 & ":" & _
                OutputCheckColumnLetter & .Range("A" & _
                Rows.Count).End(xlUp).Row).Formula = "=R[-1]C+RC[-3]-RC[-4]"        '   Write rest of formulas to 'Check' column (J3 to last row)
        .Range(OutputCheckColumnLetter & StartRow & ":" & OutputCheckColumnLetter & _
                .Range("A" & Rows.Count).End(xlUp).Row).Value = _
                .Range(OutputCheckColumnLetter & StartRow & ":" & _
                OutputCheckColumnLetter & .Range("A" & Rows.Count).End(xlUp).Row).Value '   Remove formulas from Column J in the new sheet leaving just the values
'
        .Columns(OutputClosingBalanceColumnLetter & ":" & _
                OutputCheckColumnLetter).NumberFormat = "#,##0.00"                  '   Format Columns I & J to commas & 2 decimal places
'
        With .UsedRange                                                             '   Format all Columns on the new sheet
            .Columns.Font.Name = "Calibri"
            .Columns.Font.Size = 11
            .WrapText = False
            .Columns.AutoFit
            .Rows.AutoFit
        End With
    End With
'
    Application.ScreenUpdating = True                                               ' Turn ScreenUpdating back on
'
    If Trim(OutputSheet.Range(OutputClosingBalanceColumnLetter & OutputSheet.Range("A" & _
            Rows.Count).End(xlUp).Row)) = Trim(OutputSheet.Range(OutputCheckColumnLetter & _
            OutputSheet.Range("A" & Rows.Count).End(xlUp).Row)) Then                ' If last used cell in Column I = last used cell in Column J then ...
        MsgBox "Data cleaned & Matched Sccessfully"                                 '   Display Matched message
    Else                                                                            ' Else ...
        MsgBox "Mismatched. Check if any row is missed to enter"                    '   Display Mismatched message
    End If
End Sub

You asked for a rewrite, there you go.
I think I touched all of the bases.
I variableized the hell out of it, putting all variables that may need changing towards the top of the script. This hopefully will ease making other bank statements easier to adapt.
I hopefully made the date work first try. Let us know about that. I know how that always seems to be an issue with you.

Let us know how it works for you.