Voucher data flow through VBA

Zubair

Active Member
Joined
Jul 4, 2009
Messages
299
Office Version
  1. 2016
Platform
  1. Windows
Hi experts,

Please help to fix the following.

1. If Tab "Voucher" Cell H4 = "Payment" then D11 = O2
2. If Tab "Voucher" Cell H4 = "Credit" then D11 = O3, and "Database" Column H figure required with a negative sign (example -5,240)
3. O2 & O3 is showing the starting document number, which required plus 1 on each new entry
4. It is required to check "Database" column A also to avoid duplication & maintain sequence without skipping serial like incase of re-set.

Voucher
Voucher.xlsm
ABCDEFGHIJKLMNOP
1Credit voucherCV
2Voucher Entry FormPV70000
3CV90000
4Nature
5
6Customer NameVoucher No.
7
8Customer NoVoucher Date
9
10S. No.Against Invoice No.Invoice Date  Cash Amount
11
12
13
14
15
16
17
18
19
20
21
22Total-
23
24
25
26
27
28
Voucher
Cell Formulas
RangeFormula
N1N1=IF(H4="Payment","Payment voucher","Credit voucher")
O1O1=IF(H4="Payment","PV","CV")
E6E6=IF($H$4="Payment","Supplier Name","Customer Name")
E8E8=IF($H$4="Payment","Supplier No","Customer No")
G10G10=IF(I10="Cheque No.","Bank Name","")
H10H10=IF(I10="Cheque No.","Branch Name","")
J10J10=IF(I10="Cheque No.","Cheque date","")
K22K22=SUM(K11:K21)
Cells with Data Validation
CellAllowCriteria
H4ListPayment, Credit
I10ListCheque No., Cash


Database
Voucher.xlsm
ABCDEFGHIJKLMNOPQ
1Document No.Document typeTransactionSupplier/Customer No.Supplier/Customer NameVoucher No.Voucher Date Amount Transaction DateNatureAgainst Invoice No.Invoice DateBank NameBranch NameCheque No.Cheque Date
270000PVPayment voucher100ABC1011/1/202256,85212/5/2022 22:54PaymentJK-98551/1/2022Bank of ATeflon25625212/2/2022
370000PVPayment voucher100ABC1011/1/202258,00012/5/2022 22:54PaymentJK-98592/1/2022Bank of CMain Road Branch56585453/2/2022
490000CVCredit voucher1001SSS5019/5/20223,52012/5/2022 22:45Credit20048/5/2022Bank No.2Branch No.490004249/7/2022
590001CVCredit voucher1000AAA5001/1/202256,20012/5/2022 22:51Credit20051/1/2022Bank No.4Branch No.590004209/7/2022
690001CVCredit voucher1000AAA5001/1/202256,89012/5/2022 22:51Credit20062/1/2022Bank No.5Branch No.2900045510/7/2022
770001PVPayment voucher501DEF1053/3/20004,00012/5/2022 22:56PaymentJK-90002/2/2000Cash
890002CVCredit voucher1010CCC5105/6/20225,24013-05-2022 09:46:29Credit20107/9/2022Cash
990003CVCredit voucher1012UUU52019/05/202265013-05-2022 12:02:59Credit2138/9/2022Cash
10
11
Database


VBA
Sub SaveNewDataVoucher()
Application.ScreenUpdating = False
Dim LastRow As Long, vouWS As Worksheet, desWS As Worksheet, brand As Range
Set vouWS = Sheets("Voucher")
Set desWS = Sheets("Database")

With vouWS

For Each brand In .Range("E11", .Range("E" & .Rows.Count).End(xlUp))
LastRow = desWS.Range("E" & .Rows.Count).End(xlUp).Row + 1

desWS.Range("A" & LastRow).Resize(, 1).Value = Array(.Range("D11"))
desWS.Range("B" & LastRow).Resize(, 2).Value = Array(.Range("O1"), .Range("N1"))
desWS.Range("D" & LastRow).Resize(, 4).Value = Array(.Range("F8"), .Range("F6"), .Range("K6"), .Range("K8"))
desWS.Range("K" & LastRow).Resize(, 6).Value = .Range("E" & brand.Row).Resize(, 6).Value
desWS.Range("H" & LastRow).Value = .Range("K" & brand.Row)
desWS.Range("I" & LastRow).Resize(, 1).Value = Array([Text(Now(), "DD-MM-YYYY HH:MM:SS")])
desWS.Range("J" & LastRow).Resize(, 1).Value = Array(.Range("H4"))


Next brand
End With
Call ResetVoucher
Application.ScreenUpdating = True
End Sub

Sub ResetVoucher()
Application.ScreenUpdating = False
Dim vouWS As Worksheet, desWS As Worksheet
Set vouWS = Sheets("Voucher")
Set desWS = Sheets("Database")
With vouWS
.Range("H4,F6,F8,K6,K8").Interior.Color = xlNone
.Range("H4,F6,F8,K6,K8").Value = ""
.Range("E11:K21").Interior.Color = xlNone
.Range("E11:K21").Value = ""
.Range("E11,F21").Interior.Color = xlNone
.Range("D11,F21").Value = ""
End With
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Forum statistics

Threads
1,213,584
Messages
6,114,509
Members
448,575
Latest member
hycrow

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