write formula within the code & conditional msg box

[RAJESH1960]

Hello guys

Here I have this bank sheet, the data of which is from different sheets and is appended. I am trying to clean this sheet just like in the expected result sheet. John Topley was very supportive in writing the code to get the result. But I was not able to make him understand the below 2 points. I really hope someone in this forum, understands this.

The problem is that, in column H, the amounts are just copied from column G without the format Cr/ Dr and entered. If I failed to enter any of the rows while appending the data, still it would should the final amounts as matched in the H column.

This is what exactly I need in the code. After sorting the line from largest to smallest, the first amount in cell H2 to be copied from G2 without the format, i.e., Dr / Cr which is already done in the code. In column H3 I want to insert a formula and drag it down to the end to check whether the balance is matched with column G last row. The formula to be applied to H3 is “(=H2+F3-E3)”.

In the end I need to place a msg box with a condition, i.e., If the amount in column G last row without the format Dr / Cr is equivalent to the amount in column H last row, then the msg box should display a message “Data cleaned & Matched Successfully”, else ”Mismatched. Check if any row is missed to enter”.
If the result data has calibri font and size 11 and autofit, it would be really cool.

I need your expertise to complete the above. Thank you in advance.
Clean & customise sheet with a code.xlsm

EDIT:
Please Note: A_test is a recorded macro which I forgot to delete. The code to be edited is module1.

 

[johnnyL]

How about:

Option Explicit

Sub Bank_Clean()
'solved by John Topley

Dim hdr As Variant
Dim ar, sname As String, i As Long, n As Long, lr As Long
Dim BranchName As String, ChequeNo As String
Dim arr(1 To 10000, 1 To 9)
Dim ws1 As Worksheet, ws2 As Worksheet
hdr = Array("Line", "Txn Date", "Month", "Voucher Type", "Dr Amount", "Cr Amount", "Balance", "Check", "Narration")
Application.ScreenUpdating = False
Set ws1 = Worksheets("Bank")
ws1.Activate
ar = ws1.[A1].CurrentRegion

lr = UBound(ar, 1) - 1
sname = Replace(CStr(ar(lr, 2)) & " to " & CStr(ar(2, 2)), "/", "-")

For i = 2 To UBound(ar, 1) - 1

    BranchName = "": ChequeNo = ""
    n = i - 1
    arr(n, 1) = n
    arr(n, 2) = ar(i, 2): arr(n, 3) = ar(i, 2)
    arr(n, 5) = ar(i, 6)
    If arr(n, 5) <> 0 Then arr(n, 4) = "Payment"
    arr(n, 6) = ar(i, 7)
    If arr(n, 6) <> 0 Then arr(n, 4) = "Recipt"
    arr(n, 7) = ar(i, 8)
    arr(n, 8) = Replace(ar(i, 8), "Cr.", "")
    If ar(i, 4) <> "-" Then BranchName = " Branch Name " & ar(i, 4)
    If ar(i, 5) <> "" Then ChequeNo = " Cheque no. " & ar(i, 5)
    arr(n, 9) = ar(i, 3) & " Txn no. " & ar(i, 1) & BranchName & ChequeNo
Next i

Sheets.Add(After:=Sheets("Bank")).Name = sname
Set ws2 = Worksheets(sname)

With ws2
  lr = UBound(ar, 1) - 1
 .[A1].Resize(, 9) = hdr
 .[A2].Resize(UBound(ar, 1) - 1, 9) = arr
 .Columns("I:I").WrapText = False
 .Columns("C:C").NumberFormat = "mmm-yyyy"
 .Columns("E:F").NumberFormat = "0.00"
 .Range("A1:I" & lr).Sort Key1:=.Range("A1"), Order1:=xlDescending
 
 '
 For i = 2 To lr - 1
     n = i + 1
    .Cells(n, 8) = .Cells(i, 8) + .Cells(n, 6) - Cells(n, 5)
 Next i
'
        .Range("H3").Formula = "=H2+F3-E3"
        .Range("H3:H" & lr).FillDown
'
        With .Columns("A:I")
            .Font.Name = "Calibri"
            .Font.Size = 11
            .AutoFit
        End With
'
End With

Application.ScreenUpdating = True
'
    If Left(ws2.Range("G" & lr).Value, Len(ws2.Range("G" & lr).Value) - 4) = Trim(Int(ws2.Range("H" & lr).Value * 100) / 100) Then
        MsgBox "Data cleaned & Matched Successfully"
    Else
        MsgBox "Mismatched. Check if any row is missed to enter"
    End If
End Sub

 

[RAJESH1960]

Hello Johnnyl. I am not getting the last row in the result sheet. Sorry, I missed to notice that in John Topley's code and my expected result sheet too. The last row in Bank has to be the first in the result sheet.

 

[RAJESH1960]

There was a bank note below the data which I deleted manually and forgot to mention that.

 

[RAJESH1960]

lr = UBound(ar, 1) - 1

Does this line avoid the last row. I am not sure if not I would have edited it.

 

[RAJESH1960]

I also noticed that the narration result has multiple lines in one row. Please apply a formula in the code to get it in one line.
I use this formula to get that-
Select the whole data > Control H > in find what Press control J and replace it with blank> replace all. The data is converted from multiple lines to one line in one cell.

 

[RAJESH1960]

narration result has multiple lines

Select cells in the narration column and press F2 for each row. You will notice that some of the cells are partly shown in the address bar.

 

[johnnyL]

How about:

Option Explicit

Sub Bank_Clean()
'solved by John Topley

Dim hdr As Variant
Dim ar, sname As String, i As Long, n As Long, lr As Long
Dim BranchName As String, ChequeNo As String
Dim arr(1 To 10000, 1 To 9)
Dim ws1 As Worksheet, ws2 As Worksheet
hdr = Array("Line", "Txn Date", "Month", "Voucher Type", "Dr Amount", "Cr Amount", "Balance", "Check", "Narration")
Application.ScreenUpdating = False
Set ws1 = Worksheets("Bank")
ws1.Activate
ar = ws1.[A1].CurrentRegion
Debug.Print ar(53, 1)
''lr = UBound(ar, 1) - 1
    lr = UBound(ar, 1)
sname = Replace(CStr(ar(lr, 2)) & " to " & CStr(ar(2, 2)), "/", "-")

''For i = 2 To UBound(ar, 1) - 1
    For i = 2 To UBound(ar, 1)

    BranchName = "": ChequeNo = ""
    n = i - 1
    arr(n, 1) = n
    arr(n, 2) = ar(i, 2): arr(n, 3) = ar(i, 2)
    arr(n, 5) = ar(i, 6)
    If arr(n, 5) <> 0 Then arr(n, 4) = "Payment"
    arr(n, 6) = ar(i, 7)
    If arr(n, 6) <> 0 Then arr(n, 4) = "Recipt"
    arr(n, 7) = ar(i, 8)
    arr(n, 8) = Replace(ar(i, 8), "Cr.", "")
    If ar(i, 4) <> "-" Then BranchName = " Branch Name " & ar(i, 4)
    If ar(i, 5) <> "" Then ChequeNo = " Cheque no. " & ar(i, 5)
    arr(n, 9) = ar(i, 3) & " Txn no. " & ar(i, 1) & BranchName & ChequeNo
Next i

Sheets.Add(After:=Sheets("Bank")).Name = sname
Set ws2 = Worksheets(sname)

With ws2
''  lr = UBound(ar, 1) - 1
    lr = UBound(ar, 1)
 .[A1].Resize(, 9) = hdr
 .[A2].Resize(UBound(ar, 1) - 1, 9) = arr
 .Columns("I:I").WrapText = False
 .Columns("C:C").NumberFormat = "mmm-yyyy"
 .Columns("E:F").NumberFormat = "0.00"
 .Range("A1:I" & lr).Sort Key1:=.Range("A1"), Order1:=xlDescending
 
 '
 For i = 2 To lr - 1
     n = i + 1
    .Cells(n, 8) = .Cells(i, 8) + .Cells(n, 6) - Cells(n, 5)
 Next i
'
        .Range("H3").Formula = "=H2+F3-E3"
        .Range("H3:H" & lr).FillDown
'
        With .Columns("A:I")
            .Font.Name = "Calibri"
            .Font.Size = 11
            .AutoFit
        End With
'
        .Columns("I:I").Replace What:="" & Chr(10) & "", Replacement:=" ", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'
End With

Application.ScreenUpdating = True
'
    If Left(ws2.Range("G" & lr).Value, InStr(ws2.Range("G" & lr).Value, ".") + 2) = Trim(Int(ws2.Range("H" & lr).Value * 100) / 100) Then
        MsgBox "Data cleaned & Matched Successfully"
    Else
        MsgBox "Mismatched. Check if any row is missed to enter"
    End If

End Sub

 

[RAJESH1960]

Simply great. You solved all the problems in the code. Thanks JohnnyL.?

 

[johnnyL]

Glad to help.