write formula within the code & conditional msg box

RAJESH1960

Banned for repeated rules violations
Joined
Mar 26, 2020
Messages
2,313
Office Version
  1. 2019
Platform
  1. Windows
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.
 
Last edited by a moderator:

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
How about:

VBA Code:
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
 
Upvote 0
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.
 
Upvote 0
There was a bank note below the data which I deleted manually and forgot to mention that.
 
Upvote 0
Rich (BB code):
lr = UBound(ar, 1) - 1
Does this line avoid the last row. I am not sure if not I would have edited it.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
How about:

VBA Code:
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
 
Upvote 0
Solution
Simply great. You solved all the problems in the code. Thanks JohnnyL.?
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top