Dynamic Voucher Number

[Amir Wisal]

Hi there,

I want to generate a dynamic sequence of voucher numbers by a formula but if there is a better alternative, I am open to it.

I want it to pick the sequence number dynamically but the catch is - if column "D" states cash before the blank row, I want it to start with CPV and then the dynamic number i.e. CPV-001 etc and if the column D value is bank then the desired result needs to be BPV-001.

Each entry will be separated by a blank row however each entry might have a different number of lines.

Please see the desired result column for reference. file can also be accessed from this Link

DATE	Desired Result	ACC_CODE	ACC_DESCRIPTION	DR	CR
2022/01/01​	CPV-001	500-001	Food	300​
2022/01/01​		500-003	stationery	100​
2022/01/01​		600-001	Cash		400​
2022/01/01​	BPV-001	550-001	fuel	320​
2022/01/01​		500-008	lunch	120​
2022/01/01​		600-001	bank		440​
2022/01/02​	CPV-002	500-008	traveling	20000​
2022/01/02​		100-005	printing	10000​
2022/01/02​		550-001	postage	5000​
2022/01/02​		600-001	Cash		35000​
2022/01/02​	BPV-002	500-008	traveling	8000​
2022/01/02​		500-0011	Misc	5000​
2022/01/02​		500-012	entertainment	7000​
2022/01/02​		100-005	printing	10000​
2022/01/02​		550-001	postage	5000​
2022/01/02​		600-001	bank		35000​

Many Thanks,

 

[mumps]

Try:

Sub CreateVouncherNumber()
    Application.ScreenUpdating = False
    Dim i As Long, fRow As Long, lRow As Long, cnt1 As Long, cnt2 As Long
    With Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
        For i = 1 To .Areas.Count
            fRow = .Areas(i).Cells(1).Row
            lRow = .Areas(i).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If Range("D" & lRow) = "Cash" Then
                cnt1 = cnt1 + 1
                Range("B" & fRow) = "CPV-" & cnt1
            Else
                cnt2 = cnt2 + 1
                Range("B" & fRow) = "BPV-" & cnt1
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

 

[Amir Wisal]

Thank you very much, Mumps. i really appreciate your time and effort.

The above code works like a charm on the sample data however when i add more data to the sample data above and run the code, i does not update the voucher number as required.

it copies the voucher number above the new data and keeps on pasting it. i have highlighted the results as red below

Can you please make it work if i add more data to the tab.

Further, i want the macro to trigger whenever i type "Cash" or "Bank" in column D with values in column F, if possible. if not i can manually run it everytime.

DATE	Desired Result	ACC_CODE	ACC_DESCRIPTION	DR	CR
2022/01/01​	CPV-1	500-001	Food	300​
2022/01/01​		500-003	stationery	100​
2022/01/01​		600-001	Cash		400​
2022/01/01​	BPV-1	550-001	fuel	320​
2022/01/01​		500-008	lunch	120​
2022/01/01​		600-001	bank		440​
2022/01/02​	CPV-2	500-008	travelling	20000​
2022/01/02​		100-005	printing	10000​
2022/01/02​		550-001	postage	5000​
2022/01/02​		600-001	Cash		35000​
2022/01/02​	BPV-2	500-008	travelling	8000​
2022/01/02​		500-0011	Misc	5000​
2022/01/02​		500-012	entertainment	7000​
2022/01/02​		100-005	printing	10000​
2022/01/02​		550-001	postage	5000​
2022/01/02​		600-001	bank		35000​
2022/01/02​	BPV-2	500-008	travelling	8000​
2022/01/02​		500-0011	Misc	5000​
2022/01/02​		600-001	bank		13000​
2022/01/01​	BPV-2	500-008	lunch	120​
2022/01/01​		600-001	cash		120​

 

[mumps]

Try:

Option Compare Text
Sub CreateVouncherNumber()
    Application.ScreenUpdating = False
    Dim i As Long, fRow As Long, lRow As Long, cnt1 As Long, cnt2 As Long
    With Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
        For i = 1 To .Areas.Count
            fRow = .Areas(i).Cells(1).Row
            lRow = .Areas(i).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If Range("D" & lRow) = "Cash" Then
                cnt1 = cnt1 + 1
                Range("B" & fRow) = "CPV-" & cnt1
            Else
                cnt2 = cnt2 + 1
                Range("B" & fRow) = "BPV-" & cnt2
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

generate a dynamic sequence of voucher numbers by a formula

See if this does what you want.

22 12 19.xlsm
	A	B	C	D
1	DATE	Desired Result	ACC_CODE	ACC_DESCRIPTION
2	1/01/2022	CPV-001	500-001	Food
3	1/01/2022		500-003	stationery
4	1/01/2022		600-001	Cash
5
6	1/01/2022	BPV-001	550-001	fuel
7	1/01/2022		500-008	lunch
8	1/01/2022		600-001	bank
9
10	2/01/2022	CPV-002	500-008	traveling
11	2/01/2022		100-005	printing
12	2/01/2022		550-001	postage
13	2/01/2022		600-001	Cash
14
15	2/01/2022	BPV-002	500-008	traveling
16	2/01/2022		500-0011	Misc
17	2/01/2022		500-012	entertainment
18	2/01/2022		100-005	printing
19	2/01/2022		550-001	postage
20	2/01/2022		600-001	bank
21
Voucher Number

Cell Formulas
Range	Formula
B2:B20	B2	=IF(ISNUMBER(A1),"",LET(p,IF(XLOOKUP(TRUE,ISBLANK(A3:A21),D2:D20)="Cash","CPV","BPV"),p&TEXT(COUNTIF(B$1:B1,p&"*")+1,"-000")))

 

[Amir Wisal]

Thank you both @mumps and @Peter_SSs.

You guys made my day. Both approaches work fine.

@Peter_SSs still trying to digest the formula, seeing the use of the Let function for the first time. will break it into segments, hope it will make sense to me.

I really appreciate your time, effort and energy. Thanks again

 

[Peter_SSs]

You're welcome. Glad we could help.

If you are going for a vba approach then another option might be

Sub Voucher_Nums()
  Dim rA As Range
  Dim s As String
  Dim p As Long
  
  s = "CPV-001:BPV-001"  '<- Voucher starting values
  For Each rA In Range("D2", Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
    p = IIf(LCase(rA(rA.Count)) = "cash", 1, 9)
    rA(1, -1) = Mid(s, p, 7)
    Mid(s, p + 4, 3) = Format(Mid(s, p + 4, 3) + 1, "000")
  Next rA
End Sub