Business Management Application

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

Leave a Reply

Your email address will not be published. Required fields are marked *