First, we defines the worksheets by vba and see all vba codes for creating a receipt voucher
Dim sh As Worksheet
Set sh = Sheets("Received")
Dim sht As Worksheet
Set sht = Sheets("Transaction1")
Dim due As Worksheet
Set due = Sheets("Due register")
Dim gst As Worksheet
Set gst = Sheet12
sh.Unprotect "121" ' for unprotect the sheet
sh.Range("G7").Value = Date
Range("M20").Value = Now
If sh.Range("G5").Value = "" Then ' for Check Blank Cell
MsgBox "Please Select Head of Account" ' for msg box
sh.Protect "121"
Exit Sub
End If
If sh.Range("G9").Value = "" Then ' for Check Blank Cell
MsgBox "Please Fill Received from" ' for msg box
sh.Range("G9").Select
sh.Protect "121"
Exit Sub
End If
If sh.Range("G10").Value = "" Then ' for Check Blank Cell
MsgBox "Please Fill Billed amount" ' for msg box
sh.Range("G10").Select
sh.Protect "121"
Exit Sub
End If
If sh.Range("G11").Value = "" Then ' for Check Blank Cell
MsgBox "Please Fill Received by CASH" ' for msg box
sh.Range("G11").Select
sh.Protect "121"
Exit Sub
End If
If sh.Range("G12").Value = "" Then ' for Check Blank Cell
MsgBox "Please Fill by BANK" ' for msg box
sh.Range("G12").Select ' if blank then move to the cell
sh.Protect "121"
Exit Sub 'if condition not filled then stop running vba
End If
If sh.Range("G13").Value = "" Then ' for Check Blank Cell
MsgBox "Please write REMARK" ' for msg box
sh.Range("G13").Select ' if blank then move to the cell
sh.Protect "121"
Exit Sub 'if condition not filled then stop running vba
End If
If sh.Range("G15").Value = "" Then ' for Check Blank Cell
MsgBox "Please write Mobile No" ' for msg box
sh.Range("G15").Select ' if blank then move to the cell
sh.Protect "121"
Exit Sub 'if condition not filled then stop running vba
End If
If Range("E18").Value <> "" And Range("G18").Value = "" Then
sh.Protect "121"
MsgBox "Please input vale in Due or Due Paid or Loan Paid"
Range("G18").Select
Exit Sub
End If
' For Transaction Type
If Range("G12").Value > 0 And Range("I12").Value = "" Then
sh.Protect "121"
MsgBox "Please Select Transaction Type"
Range("I12").Select
SendKeys "%{DOWN}"
Exit Sub
End If
If Range("G12").Value > 0 And Range("M12").Value = "" Then
sh.Protect "121"
MsgBox "Please Select BANK"
Range("M12").Select
Exit Sub
End If
If sh.Range("E18") <> "" And sh.Range("G18") = "" Then
MsgBox " Please Take Action for Due, Due Paid"
Exit Sub
End If
''' for filter data''''
If sht.FilterMode = True Then
MsgBox "Pease Check and clear filter from the Transaction"
Exit Sub
Else
End If
If due.FilterMode = True Then
MsgBox "Pease Check and clear filter from the Due register"
Exit Sub
Else
End If
If Sheet12.FilterMode = True Then
MsgBox "Pease Check and clear filter from the GS STEEL"
Exit Sub
Else
End If
'for invoice number
sh.Range("K5").Value = sh.Range("K5").Value + 1
' after complete proctect again the sheet
sh.Protect "121"
' data transfer to another sheet
Dim dcc As Long
dcc = sht.Range("D" & Rows.Count).End(xlUp).Row + 1
sht.Unprotect "121"
'On Error Resume Next
With sht
.Cells(dcc, 1).Value = sh.Range("K5").Value
.Cells(dcc, 2).Value = sh.Range("G7").Value
.Cells(dcc, 3).Value = sh.Range("G5").Value
.Cells(dcc, 4).Value = sh.Range("G9").Value ' ok
.Cells(dcc, 5).Value = sh.Range("G10").Value ' billed amount
.Cells(dcc, 6).Value = sh.Range("G11").Value ' cash
.Cells(dcc, 7).Value = sh.Range("G12").Value ' bank
.Cells(dcc, 9).Value = sh.Range("I12").Value ' Transaction Type
.Cells(dcc, 10).Value = sh.Range("G13").Value ' remark
.Cells(dcc, 11).Value = sh.Range("G15").Value ' mobile
End With
Application.DisplayAlerts = False
Application.ScreenUpdating = False
' AMOUNT TRANSFER TO BANK
If Range("G12").Value > 0 Then
gst.Unprotect "121"
Dim gsR As Long
gsR = gst.Range("H" & Rows.Count).End(xlUp).Row + 1
gst.Cells(gsR, 8).Value = sh.Range("M12").Value 'BANK NAME
gst.Cells(gsR, 9).Value = sh.Range("G9").Value ' name
gst.Cells(gsR, 10).Value = "BILL@" & sh.Range("K5").Value & sh.Range("I12")
gst.Cells(gsR, 11).Value = Date + 1 'date
gst.Cells(gsR, 12).Value = sh.Range("G12").Value 'amount
gst.Cells(gsR, 14).Value = "BY SELL" 'amount
gst.Protect "121"
Else
End If
If Range("E19").Value = "Due" Then
due.Unprotect "121"
Dim bmw As Long
bmw = due.Range("b" & Rows.Count).End(xlUp).Row
due.Cells(bmw + 1, 1).Value = sh.Range("G7").Value 'date
due.Cells(bmw + 1, 2).Value = sh.Range("G9").Value 'name
due.Cells(bmw + 1, 3).Value = sh.Range("K5").Value ' bill no
due.Cells(bmw + 1, 4).Value = sh.Range("G19").Value ' due amount
Else
End If
If Range("E19").Value = "Due Paid" Then
due.Unprotect "121"
Dim Cmw As Long
Cmw = due.Range("b" & Rows.Count).End(xlUp).Row
due.Cells(Cmw + 1, 1).Value = sh.Range("G7").Value
due.Cells(Cmw + 1, 2).Value = sh.Range("G9").Value
due.Cells(Cmw + 1, 3).Value = sh.Range("K5").Value
due.Cells(Cmw + 1, 5).Value = sh.Range("G19").Value * -1 ' DUE PAID
Else
End If
Dim myFileR As String
myFileR = "C:\Voucher\" & sh.Range("K5").Value & "_" & sh.Range("G7").Value & "_" & sh.Range("G9").Value & ".pdf"
' for pdf file save
sh.Range("b2:M22").ExportAsFixedFormat xlTypePDF, Filename:=myFileR, Openafterpublish:=True
sht.Hyperlinks.Add Anchor:=sht.Cells(dcc, 1), Address:=myFileR
due.Protect "121"
' loan.Protect "121"
sht.Protect "121"
' for clear
sh.Unprotect "121"
sh.Range("G5").ClearContents
sh.Range("G9").ClearContents
sh.Range("G10").ClearContents
sh.Range("G11").ClearContents
sh.Range("M12").ClearContents
sh.Range("G12").ClearContents
sh.Range("I12:L12").ClearContents
sh.Range("G7").Value = Date
sh.Range("G13").ClearContents
sh.Range("G15").ClearContents
' sh.Range("E18:E19").ClearContents
' sh.Range("G18:G19").ClearContents
sh.Protect "121"
sh.Select
1 thought on “Business Management Application”