Clean & Customize xlsx sheet with a code

RAJESH1960 · May 11, 2022

Hello guys,
I need your expertise to help me to correct this code.
When I run the code, there is just one sheet in the workbook -"Bank". After I run the code a new sheet is created with the new name (first and last dates in the Bank sheet). That new sheet is moved and copied to a different folder. Again, I replace the data in the bank sheet and run the code. This way it goes on. Each time, I have to correct the mismatches because of the code.
The code runs without any error. Still, I am not getting the expected result and the wrong msg box as mismatched.

Changes required.
1. Column G is missing to take the 2 decimals and hence it is showing a mismatch.
2. Column G may contain Cr or Dr in different scenarios. The code shows Cr only. I would like to include Dr also in that line.
3. As there are 2 different balances Dr. & Cr, the formula to be made optional. If the column G contains Cr. Then the formula in column H should be =H2+F3-E3 and if the column G contains Cr, then the formula in column H should be =H2-F3+E3. Please note that it is possible that a single workbook with data may contain both Dr and Cr. So, if the code checks each row for Dr and Cr it can apply the formula accordingly in each row.
4. If possible, Column G to be copied as it is without removing Dr. Cr.

After that, I hope that will solve all the problems
FYI, This code was posted in other forum a few days back. But as I was not able to get the expected result, I am sharing it here again.
0. Edit code Clean & customise.xlsm

RAJESH1960 · May 11, 2022

If the balance column contains Cr. then the formula applied in cell H3 will be ==H2-E3+F3. The value in cell H2 is copied from G2 without the Dr. after sorting the data by line from largest to smallest
The expected result of Dr. is as below

Line	Txn Date	Month	Voucher Type	Dr Amount	Cr Amount	Balance	Check	Narration
50	04-04-2022	Apr-2022	Recipt		17329.00	2,02,34,637.3 7 Dr.	20234637.37	SEFT_IS:269864133 31SXC/0026/ TUMKUS MESCHASTS CSE Txn no. S23164584
49	05-04-2022	Apr-2022	Recipt		4050.00	2,02,30,587.3 7 Dr.	20230587.37	SEFT_IS:SXIS32209 5227592/0033/ VVMVP Txn no. S49355010
48	06-04-2022	Apr-2022	Recipt		18209.00	2,02,12,378.3 7 Dr.	20212378.37	XY ISST 55443 : CTO386-1 SXAY LAT Txn no. S68979605
47	06-04-2022	Apr-2022	Recipt		18000.00	2,01,94,378.3 7 Dr.	20194378.37	XY ISST 250688 : CTO386-1 SXAY LAT Txn no. S68979605
46	06-04-2022	Apr-2022	Payment	18000.00		2,02,12,378.3 7 Dr.	20212378.37	WSOSGLY CHQ CSESXITESX Txn no. M1149047
45	07-04-2022	Apr-2022	Recipt		18000.00	2,01,94,378.3 7 Dr.	20194378.37	XY ISST 250688 : CTO386-1 SXAY LAT Txn no. S84642018
44	07-04-2022	Apr-2022	Recipt		2327.00	2,01,92,051.3 7 Dr.	20192051.37	SEFT_IS:270385894 11SXC/0029/ TUMKUS MESCHASTS CSE Txn no. S88549767
43	11-04-2022	Apr-2022	Recipt		500.00	2,01,91,551.3 7 Dr.	20191551.37	UPI/210100547184/P 2A/0000001028/ifsc.S pciPaytm Txn no. S56993294
42	11-04-2022	Apr-2022	Recipt		10613.00	2,01,80,938.3 7 Dr.	20180938.37	SEFT_IS:270878793 21SXC/0035/ TUMKUS MESCHASTS CSE Txn no. S77404573
41	12-04-2022	Apr-2022	Recipt		9280.00	2,01,71,658.3 7 Dr.	20171658.37	XY ISST 202 : CTO386-1 SXAY LAT Txn no. S88579325
40	12-04-2022	Apr-2022	Recipt		96819.00	2,00,74,839.3 7 Dr.	20074839.37	SEFT_IS:S10222191 5885587/0037/ A A VESTUSES Txn no. S96963561
39	13-04-2022	Apr-2022	Recipt		30510.00	2,00,44,329.3 7 Dr.	20044329.37	SEFT_IS:0413i27405 850061/0022/ HASYASA HASSXLOOM CESTSE Txn no. S6836125
38	13-04-2022	Apr-2022	Recipt		18000.00	2,00,26,329.3 7 Dr.	20026329.37	XY ISST 250689 : CTO386-1 SXAY LAT Txn no. S7402938
37	16-04-2022	Apr-2022	Recipt		2466.00	2,00,23,863.3 7 Dr.	20023863.37	SEFT_IS:271620137 21SXC/0029/ TUMKUS MESCHASTS CSE Txn no. S66857366
36	18-04-2022	Apr-2022	Recipt		23445.00	2,00,00,418.3 7 Dr.	20000418.37	SEFT_IS:0418i27412 872101/0024/ HASYASA HASSXLOOM CESTSE Txn no. S99909549
35	18-04-2022	Apr-2022	Recipt		10886.00	1,99,89,532.3 7 Dr.	19989532.37	SEFT_IS:271803171 31SXC/0027/ TUMKUS MESCHASTS CSE Txn no. S1794883
34	19-04-2022	Apr-2022	Payment	236.00		1,99,89,768.3 7 Dr.	19989768.37	SHOSTFAL SEC- ISw StSS ChSgs:297857 Txn no. S15659993
33	19-04-2022	Apr-2022	Payment	236.00		1,99,90,004.3 7 Dr.	19990004.37	SHOSTFAL SEC- ISw StSS ChSgs:297866 Txn no. S15660860
32	19-04-2022	Apr-2022	Payment	236.00		1,99,90,240.3 7 Dr.	19990240.37	SHOSTFAL SEC- ISw StSS ChSgs:297875 Txn no. S15660924
31	19-04-2022	Apr-2022	Payment	236.00		1,99,90,476.3 7 Dr.	19990476.37	SHOSTFAL SEC- ISw StSS ChSgs:321803 Txn no. S15660976
30	19-04-2022	Apr-2022	Payment	236.00		1,99,90,712.3 7 Dr.	19990712.37	SHOSTFAL SEC- ISw StSS ChSgs:404421 Txn no. S15661047
29	19-04-2022	Apr-2022	Payment	236.00		1,99,90,948.3 7 Dr.	19990948.37	SHOSTFAL SEC- ISw StSS ChSgs:404409 Txn no. S15661113
28	19-04-2022	Apr-2022	Payment	236.00		1,99,91,184.3 7 Dr.	19991184.37	SHOSTFAL SEC- ISw StSS ChSgs:959930 Txn no. S15661177
27	19-04-2022	Apr-2022	Payment	236.00		1,99,91,420.3 7 Dr.	19991420.37	SHOSTFAL SEC- ISw StSS ChSgs:297866 Txn no. S15662064
26	19-04-2022	Apr-2022	Payment	236.00		1,99,91,656.3 7 Dr.	19991656.37	SHOSTFAL SEC- ISw StSS ChSgs:297877 Txn no. S15662178
25	19-04-2022	Apr-2022	Payment	236.00		1,99,91,892.3 7 Dr.	19991892.37	SHOSTFAL SEC- ISw StSS ChSgs:297902 Txn no. S15662306
24	19-04-2022	Apr-2022	Payment	236.00		1,99,92,128.3 7 Dr.	19992128.37	SHOSTFAL SEC- ISw StSS ChSgs:297878 Txn no. S15662847
23	19-04-2022	Apr-2022	Payment	236.00		1,99,92,364.3 7 Dr.	19992364.37	SHOSTFAL SEC- ISw StSS ChSgs:297843 Txn no. S15662989
22	19-04-2022	Apr-2022	Payment	236.00		1,99,92,600.3 7 Dr.	19992600.37	SHOSTFAL SEC- ISw StSS ChSgs:297856 Txn no. S15663110
21	19-04-2022	Apr-2022	Payment	236.00		1,99,92,836.3 7 Dr.	19992836.37	SHOSTFAL SEC- ISw StSS ChSgs:297857 Txn no. S15663248
20	19-04-2022	Apr-2022	Payment	236.00		1,99,93,072.3 7 Dr.	19993072.37	SHOSTFAL SEC- ISw StSS ChSgs:321804 Txn no. S15663352
19	19-04-2022	Apr-2022	Payment	502.68		1,99,93,575.0 5 Dr.	19993575.05	SHOSTFAL SEC- LeSXgeS Folio ChaSges fSom 01-01-2022 Txn no. S15663487
18	19-04-2022	Apr-2022	Payment	236.00		1,99,93,811.0 5 Dr.	19993811.05	SHOSTFAL SEC- ISw StSS ChSgs:297918 Txn no. S15663574
17	19-04-2022	Apr-2022	Payment	236.00		1,99,94,047.0 5 Dr.	19994047.05	SHOSTFAL SEC- ISw StSS ChSgs:115907 Txn no. S15664459
16	19-04-2022	Apr-2022	Payment	236.00		1,99,94,283.0 5 Dr.	19994283.05	SHOSTFAL SEC- ISw StSS ChSgs:297879 Txn no. S15664537
15	21-04-2022	Apr-2022	Recipt		2288.00	1,99,91,995.0 5 Dr.	19991995.05	SEFT_IS:272317265 71SXC/0032/ TUMKUS MESCHASTS CSE Txn no. S66220097
14	26-04-2022	Apr-2022	Recipt		11015.00	1,99,80,980.0 5 Dr.	19980980.05	IMPS- IS/211604568698/000 0000000/OSe97 Co Txn no. S45813243
13	26-04-2022	Apr-2022	Payment	17000.00		1,99,97,980.0 5 Dr.	19997980.05	KASHA -011900 Txn no. M1028982 Branch Name NEW DELHI BANK STREET KAROLBAGH Cheque no. 297872
12	26-04-2022	Apr-2022	Recipt		34090.00	1,99,63,890.0 5 Dr.	19963890.05	IMPS- IS/211615145060/990 0514264/JUST LIS Txn no. S59135511
11	26-04-2022	Apr-2022	Payment	17000.00		1,99,80,890.0 5 Dr.	19980890.05	SAI PSIYASXASSHISI Txn no. M1173671 Cheque no. 257660
10	26-04-2022	Apr-2022	Payment	15000.00		1,99,95,890.0 5 Dr.	19995890.05	SAI PSIYASXASSHISI Txn no. M956493 Cheque no. 257659
9	27-04-2022	Apr-2022	Payment	236.00		1,99,96,126.0 5 Dr.	19996126.05	SHOSTFAL SEC- ISw StSS ChSgs:257651 Txn no. S69927903
8	27-04-2022	Apr-2022	Recipt		3914.00	1,99,92,212.0 5 Dr.	19992212.05	SEFT_IS:273028483 91SXC/0025/ TUMKUS MESCHASTS CSE Txn no. S75478331
7	27-04-2022	Apr-2022	Recipt		7315.00	1,99,84,897.0 5 Dr.	19984897.05	IMPS- IS/211715196767/990 0514264/JUST LIS Txn no. S78963863
6	28-04-2022	Apr-2022	Payment	15000.00		1,99,99,897.0 5 Dr.	19999897.05	SAI PSIYASXASSHISI Txn no. M654992 Cheque no. 257661
5	29-04-2022	Apr-2022	Recipt		20051.00	1,99,79,846.0 5 Dr.	19979846.05	SEFT_IS:SXIS72211 9423852/0030/ SSSST XSSX Txn no. S18761777
4	30-04-2022	Apr-2022	Payment	9100.00		1,99,88,946.0 5 Dr.	19988946.05	SX15987819CS TO004000990000077 4 Txn no. S26662454
3	30-04-2022	Apr-2022	Payment	236.00		1,99,89,182.0 5 Dr.	19989182.05	IW CHQ : 297844 SEJ Txn no. S32462512
2	30-04-2022	Apr-2022	Payment	10000.00		1,99,99,182.05 Dr.	19999182.05	SAI PSIYASXASSHISI Txn no. M513559 Cheque no. 257662
1	30-04-2022	Apr-2022	Payment	196568.00		2,01,95,750.05 Dr.	20195750.05	0040008700012345 St.Coll:01-04-2022 to 30-04-202 Txn no. S44791543

johnnyL · May 11, 2022

How about:

VBA Code:

Option Explicit

Sub Bank_Clean()
'
'shared by CheeseSandwich
    Dim ar
    Dim i                       As Long
    Dim n                       As Long
    Dim lr                      As Long
    Dim BranchName              As String, ChequeNo As String
    Dim sname                   As String
    Dim arr(1 To 10000, 1 To 9)
    Dim hdr                     As Variant
    Dim ws1                     As Worksheet, ws2   As Worksheet
'
    Application.ScreenUpdating = False
'
    hdr = Array("Line", "Txn Date", "Month", "Voucher Type", "Dr Amount", "Cr Amount", "Balance", "Check", "Narration")
'
    Set ws1 = Worksheets("Bank")
'
    lr = ws1.Range("A" & Rows.Count).End(xlUp).Row
    ws1.Range("H2:H" & lr).Replace What:="" & Chr(10) & "", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False      ' Remove any 'Balance' Column H Line feeds
'
    With ws1.Range("H2:H" & lr)
        .VerticalAlignment = xlTop
        .Font.Name = "Calibri Light"
        .Font.FontStyle = "Bold"
        .Font.Size = 14
    End With
'
    ws1.Columns("H:H").AutoFit
'
    ar = ws1.[A1].CurrentRegion
    lr = UBound(ar, 1)
    sname = Replace(CStr(ar(lr, 2)) & " to " & CStr(ar(2, 2)), "/", "-")
'
    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) = CDbl(Split(Replace(ar(i, 8), " ", vbNewLine), Chr(10))(0))
        arr(n, 8) = CDbl(Split(Replace(ar(i, 8), " ", vbNewLine), Chr(10))(0))
        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)
        .[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
            .Cells(n, 8) = .Cells(i, 8) + .Cells(n, 6).Value - .Cells(n, 5).Value
            n = i + 1
        Next i
        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
'
        .Range("H3:H" & lr).Formula = "=R[-1]C-RC[-2]+RC[-3]"
        .Range("H3:H" & lr).Value = .Range("H3:H" & lr).Value
'
        Application.ScreenUpdating = True
        If Left(.Range("G" & lr).Value, InStr(.Range("G" & lr).Value, ".") + 2) = Trim(Int(.Range("H" & lr).Value * 100) / 100) Then
            MsgBox "Data cleaned & Matched Sccessfully"
        Else
            MsgBox "Mismatched. Check if any row is missed to enter"
        End If
    End With
End Sub

RAJESH1960 · May 12, 2022

johnnyL said:

How about:

VBA Code:

Option Explicit

Sub Bank_Clean()
'
'shared by CheeseSandwich
    Dim ar
    Dim i                       As Long
    Dim n                       As Long
    Dim lr                      As Long
    Dim BranchName              As String, ChequeNo As String
    Dim sname                   As String
    Dim arr(1 To 10000, 1 To 9)
    Dim hdr                     As Variant
    Dim ws1                     As Worksheet, ws2   As Worksheet
'
    Application.ScreenUpdating = False
'
    hdr = Array("Line", "Txn Date", "Month", "Voucher Type", "Dr Amount", "Cr Amount", "Balance", "Check", "Narration")
'
    Set ws1 = Worksheets("Bank")
'
    lr = ws1.Range("A" & Rows.Count).End(xlUp).Row
    ws1.Range("H2:H" & lr).Replace What:="" & Chr(10) & "", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False      ' Remove any 'Balance' Column H Line feeds
'
    With ws1.Range("H2:H" & lr)
        .VerticalAlignment = xlTop
        .Font.Name = "Calibri Light"
        .Font.FontStyle = "Bold"
        .Font.Size = 14
    End With
'
    ws1.Columns("H:H").AutoFit
'
    ar = ws1.[A1].CurrentRegion
    lr = UBound(ar, 1)
    sname = Replace(CStr(ar(lr, 2)) & " to " & CStr(ar(2, 2)), "/", "-")
'
    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) = CDbl(Split(Replace(ar(i, 8), " ", vbNewLine), Chr(10))(0))
        arr(n, 8) = CDbl(Split(Replace(ar(i, 8), " ", vbNewLine), Chr(10))(0))
        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)
        .[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
            .Cells(n, 8) = .Cells(i, 8) + .Cells(n, 6).Value - .Cells(n, 5).Value
            n = i + 1
        Next i
        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
'
        .Range("H3:H" & lr).Formula = "=R[-1]C-RC[-2]+RC[-3]"
        .Range("H3:H" & lr).Value = .Range("H3:H" & lr).Value
'
        Application.ScreenUpdating = True
        If Left(.Range("G" & lr).Value, InStr(.Range("G" & lr).Value, ".") + 2) = Trim(Int(.Range("H" & lr).Value * 100) / 100) Then
            MsgBox "Data cleaned & Matched Sccessfully"
        Else
            MsgBox "Mismatched. Check if any row is missed to enter"
        End If
    End With
End Sub

JohnnyL. This code is perfect for data with Dr Balances. If you can make it working for both kind of data Dr. & Cr it would be perfect.
'
How about an if function here, If the character is Dr. then use this formula

Rich (BB code):

 .Range("H3:H" & lr).Formula = "=R[-1]C-RC[-2]+RC[-3]"
        .Range("H3:H" & lr).Value = .Range("H3:H" & lr).Value

'
Else use this formula
'

Rich (BB code):

   .Range("H3:H" & lr).Formula = "=R[-1]C+RC[-2]-RC[-3]"
        .Range("H3:H" & lr).Value = .Range("H3:H" & lr).Value

'

Solved Edit code Clean & customise.xlsm

A

B

C

D

E

F

G

H

I

1

Txn No.

Txn Date

Description

Branch Name

Cheque No.

Dr Amount

Cr Amount

Balance

2

S69885471

27-04-2021

POS 111719025266 HPCL JAI HIND \

-

300.00

406.11 Cr.

3

S66829757

27-04-2021

00400021000010101 To: 0040005501234567

ASDF

24,500.00

706.11 Cr.

4

S66693877

27-04-2021

ATM REV 7124 PNB \+ NO 8 ROAD \ BENGA

ABCD

12345678

15,000.00

25,206.11 Cr.

5

S66693668

27-04-2021

ATM WDR 7124 PNB \+ NO 8 ROAD \ BENGA

-

12345679

15,000.00

10,206.11 Cr.

6

S66506332

27-04-2021

0040005501234567 To: 00400021000010101

-

12345670

25,000.00

25,206.11 Cr.

7

S56892399

26-04-2021

POS 111617913133 Ho Transport Northgdwn \

HIJK

240.00

206.11 Cr.

8

S24638730

23-04-2021

POS 111313920305 Ho Transport Northgdwn \

-

640.00

446.11 Cr.

9

S15229580

22-04-2021

POS 111217851515 SUN ENTERPRISES \

-

1,000.00

1,086.11 Cr.

10

S14210565

22-04-2021

0040008700003314 To: 00400021000010101

-

2,000.00

2,086.11 Cr.

11

S3654235

21-04-2021

POS 111117022323 LAKSHMAMMA AND SONS \

-

300.00

86.11 Cr.

12

S1196867

21-04-2021

CHRG BAL 111114024410 +BENGALURU CANTONMENT \

-

10.62

386.11 Cr.

13

S312250

21-04-2021

POS 111113828860 SAFE AUTO \

-

198.50

396.73 Cr.

14

S78210123

19-04-2021

POS 110917543980 SAFE AUTO \

-

297.75

595.23 Cr.

15

S75219691

19-04-2021

POS 110914900731 Ho Transport Northgdwn \

M G ROAD

12345689

1,370.00

892.98 Cr.

16

S75059716

19-04-2021

0040005501234567 To: 00400021000010101

-

1,500.00

2,262.98 Cr.

17

S73751170

19-04-2021

POS 110912298055 SRI HANUMAN ST\

-

300.00

762.98 Cr.

18

S56333596

17-04-2021

POS 110716112239 CAUVERY AUTO \

-

992.50

1,062.98 Cr.

19

S56055857

17-04-2021

0040005501234567 To: 00400021000010101

-

1,200.00

2,055.48 Cr.

20

S53652587

17-04-2021

RREF/W01/106220931647/60 7093XX

-

4.50

855.48 Cr.

21

S32448437

15-04-2021

POS 110519007566 HPCL JAI HIND \

-

300.00

850.98 Cr.

22

S29688289

15-04-2021

POS 110516574363 SAFE AUTO \

-

300.00

1,150.98 Cr.

23

S21895945

15-04-2021

SHORTFAL REC- QAB Charges from 01-01-2021 to 31-03

-

223.02

1,450.98 Cr.

24

S20138476

14-04-2021

0040005501234567 To: 00400021000010101

XXXX

21312163

1,000.00

1,674.00 Cr.

25

S15104179

14-04-2021

POS 110413586859 INDIA GARAGE S\

-

300.00

674.00 Cr.

26

S2885882

13-04-2021

POS 110314027233 EAST END \

-

300.00

974.00 Cr.

27

S90438219

12-04-2021

POS 110217030404 INDIA GARAGE ENTERPRISES \

-

8,726.00

1,274.00 Cr.

28

S89570267

12-04-2021

0040008700003314 To: 00400021000010101

-

10,000.00

10,000.00 Cr.

29

S81983824

12-04-2021

QAB Charges from 01-01- 2021 to 31-03-2021

-

130.98

0.00 Cr.

30

S78233624

11-04-2021

POS 110118013506 EAST END \

-

300.00

130.98 Cr.

31

S67100084

10-04-2021

POS 110016918038 Ho Transport Northgdwn \

-

800.00

430.98 Cr.

32

S67018514

10-04-2021

0040005501234567 To: 00400021000010101

-

1,000.00

1,230.98 Cr.

33

S62565019

10-04-2021

SMS CHRG FOR:01-01- 2021to31-03-2021

-

29.50

230.98 Cr.

34

S50821569

09-04-2021

POS 109913060943 SAFE AUTO \

-

12365478

300.00

260.48 Cr.

35

S37624092

08-04-2021

POS 109815242197 K N GURUSWAMY \

-

913.94

560.48 Cr.

36

S37478882

08-04-2021

POS 109815902040 CHAWLA MOTORS \

-

1,900.00

1,474.42 Cr.

37

S37470235

08-04-2021

0040005501234567 To: 00400021000010101

-

1,000.00

3,374.42 Cr.

38

S37453319

08-04-2021

0040005501234567 To: 00400021000010101

-

2,000.00

2,374.42 Cr.

39

S11991375

06-04-2021

POS 109618689975 INDIA GARAGE S\

-

300.00

374.42 Cr.

40

S9153492

06-04-2021

POS 109616519680 SAFE AUTO \

-

595.50

674.42 Cr.

41

S8994029

06-04-2021

0040005501234567 To: 00400021000010101

-

1,000.00

1,269.92 Cr.

42

S5533275

06-04-2021

POS 109612003339 EAST END \

-

300.00

269.92 Cr.

43

S95595597

05-04-2021

POS 109517918144 Ho Transport Northgdwn \

-

560.00

569.92 Cr.

44

S76705802

04-04-2021

INCIDENTAL CHARGES

-

306.80

1,129.92 Cr.

45

S47162918

02-04-2021

POS REV 109212541089 SAFE AUTO \

-

300.00

1,436.72 Cr.

46

S47083429

02-04-2021

POS REV 109212542261 SAFE AUTO \

-

22235656

300.00

1,136.72 Cr.

47

S47080897

02-04-2021

POS 109212542261 SAFE AUTO \

-

300.00

836.72 Cr.

48

S47064890

02-04-2021

POS 109212541089 SAFE AUTO \

-

300.00

1,136.72 Cr.

49

S47038295

02-04-2021

POS REV 109212546495 SAFE AUTO \

-

300.00

1,436.72 Cr.

50

S47035526

02-04-2021

POS 109212546495 SAFE AUTO \

-

300.00

1,136.72 Cr.

51

S46983651

02-04-2021

POS REV 109212534066 SAFE AUTO \

-

297.75

1,436.72 Cr.

52

S46982518

02-04-2021

POS 109212534066 SAFE AUTO \

AVENUE ROAD

297.75

1,138.97 Cr.

53

S46888029

02-04-2021

0040005501234567 To: 00400021000010101

-

1,000.00

1,436.72 Cr.

Bank

RAJESH1960 · May 12, 2022

This is the correct code shared by John Topley for Cr. The problem is it doesn't match with Dr. amounts due to the single formula in the code.

Rich (BB 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

RAJESH1960 · May 12, 2022

There is a more easier and simple way to solve the above issue. Your code is working correctly if the data is Dr right. You can just add one line in the code stating that if the data has Cr then interchange the columns with values in column F and G like post Cr amount in column F and Dr amount in column G in the sheet extracted from the code. That way the code will work with a single formula.

johnnyL · May 12, 2022

Try this:

VBA Code:

Option Explicit

Sub Bank_Clean()
'
'shared by CheeseSandwich
    Dim ar
    Dim i                       As Long
    Dim n                       As Long
    Dim lr                      As Long
    Dim BranchName              As String, ChequeNo As String
    Dim sname                   As String
    Dim arr(1 To 10000, 1 To 9)
    Dim hdr                     As Variant
    Dim ws1                     As Worksheet, ws2   As Worksheet
'
    Application.ScreenUpdating = False
'
    hdr = Array("Line", "Txn Date", "Month", "Voucher Type", "Dr Amount", "Cr Amount", "Balance", "Check", "Narration")
'
    Set ws1 = Worksheets("Bank")
'
    ar = ws1.[A1].CurrentRegion
    lr = UBound(ar, 1)
    sname = Replace(CStr(ar(lr, 2)) & " to " & CStr(ar(2, 2)), "/", "-")
'
    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) = Replace(ar(i, 8), Chr(10), "")
        arr(n, 8) = CDbl(Left$(arr(n, 7), Len(arr(n, 7)) - 4))
        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)
        .[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
            .Cells(n, 8) = .Cells(i, 8) + .Cells(n, 6).Value - .Cells(n, 5).Value
            n = i + 1
        Next i
        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
'
        .Range("H3:H" & lr).Formula = "=IF(RIGHT(RC[-1],3)=""Dr."", R[-1]C-RC[-2]+RC[-3],R[-1]C+RC[-2]-RC[-3])"
        .Range("H3:H" & lr).Value = .Range("H3:H" & lr).Value
'
        Application.ScreenUpdating = True
        If Replace(Left(.Range("G" & lr).Value, InStr(.Range("G" & lr).Value, ".") + 2), ",", "") _
                = Trim(Int(.Range("H" & lr).Value * 100) / 100) Then
            MsgBox "Data cleaned & Matched Sccessfully"
        Else
            MsgBox "Mismatched. Check if any row is missed to enter"
        End If
    End With
End Sub

RAJESH1960 · May 12, 2022

Will check and revert back in sometime.

RAJESH1960 · May 12, 2022

JohnnyL. The great. The code is perfect. All the 4 requirements I had stated have been incorporated and the result is superb. Thanks man.

johnnyL · May 12, 2022

Glad to help.

Clean & Customize xlsx sheet with a code

RAJESH1960

Banned for repeated rules violations

Excel Facts

RAJESH1960

Banned for repeated rules violations

johnnyL

Well-known Member

RAJESH1960

Banned for repeated rules violations

RAJESH1960

Banned for repeated rules violations

RAJESH1960

Banned for repeated rules violations

johnnyL

Well-known Member

RAJESH1960

Banned for repeated rules violations

RAJESH1960

Banned for repeated rules violations

johnnyL

Well-known Member

Similar threads

Forum statistics

Share this page

Clean & Customize xlsx sheet with a code

Banned for repeated rules violations

Excel Facts

Banned for repeated rules violations

Well-known Member

Banned for repeated rules violations

Banned for repeated rules violations

Banned for repeated rules violations

Well-known Member

Banned for repeated rules violations

Banned for repeated rules violations

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock