Forum Discussion
assistance in VBA that will enable me to have mandatory fields and lock rows when complete
Dear Excel Community,
I am working on a small person project using Excel VBA.
I got this Idea from a youtube profile. the video is called Using Invoice Template to Automate Invoice Creation and Printing with VBA by Dinesh Kumar Takyar
I have tried but failed to acquire what I wanted hence have come here for assistance.
I have an Excel workbook which is a receipt (named receipt) while another workbook is the data entry (named Testing). (I have them attached)
Basically what happens is that in the "Testing document, I enter data and when I Click Print, the data will go to the Receipt workbook, Save the receipt as defined in VBA and take it to the Printer. once this action has taken place, a DONE will be written at the end of the Row in the Testing workbook
I want to now achieve 2 things
1: I would like all the all the fields in the Testing workbook to be mandatory that will then allow me to print
2: I would like that when the row has its last Column "DONE" that it gets locked so no one can edit it late.
I hope to get the assistance in that. and appreciate the help I get.
Below are are current VBA codes i have used
Private Sub CommandButton1_Click()
Dim name As String
Dim invoiceno As Long
Dim paymentmethod As String
Dim collectedby As String
Dim item As String
Dim item2 As String
Dim r As Long
Dim mydate As String
Dim path As String
Dim myfilename As String
lastrow = Sheets("Details").Range("A" & Rows.Count).End(xlUp).Row
r = 2
For r = 2 To lastrow
If Cells(r, 13).Value = "done" Then GoTo Nextrow
name = Sheets("Details").Cells(r, 1).Value
invoiceno = Sheets("Details").Cells(r, 2).Value
paymentmethod = Sheets("Details").Cells(r, 4).Value
collectedby = Sheets("Details").Cells(r, 5).Value
quantity = Sheets("Details").Cells(r, 6).Value
quantity2 = Sheets("Details").Cells(r, 7).Value
item = Sheets("Details").Cells(r, 8).Value
item2 = Sheets("Details").Cells(r, 9).Value
UnitPrice = Sheets("Details").Cells(r, 10).Value
UnitPrice2 = Sheets("Details").Cells(r, 11).Value
Cells(r, 13).Value = "done"
Application.DisplayAlerts = False
Workbooks.Open ("C:\Users\Hp\Documents\receipt\receipt.xlsx")
ActiveWorkbook.Sheets("test").Activate
ActiveWorkbook.Sheets("test").Range("A9").Value = quantity
ActiveWorkbook.Sheets("test").Range("A10").Value = quantity2
ActiveWorkbook.Sheets("test").Range("B3").Value = name
ActiveWorkbook.Sheets("test").Range("B6").Value = paymentmethod
ActiveWorkbook.Sheets("test").Range("B9").Value = item
ActiveWorkbook.Sheets("test").Range("B10").Value = item2
ActiveWorkbook.Sheets("test").Range("C9").Value = UnitPrice
ActiveWorkbook.Sheets("test").Range("C10").Value = UnitPrice2
ActiveWorkbook.Sheets("test").Range("D3").Value = invoiceno
ActiveWorkbook.Sheets("test").Range("D6").Value = collectedby
path = "C:\Users\Hp\Documents\receipt\"
mydate = Date
mydate = Format(mydate, "dd_mm_yyyy")
ActiveWorkbook.SaveAs Filename:=path & invoiceno & " - " & name & " - " & mydate & ".xlsx"
myfilename = ActiveWorkbook.FullName
'SetAttr myfilename, vbReadOnly
Application.DisplayAlerts = True
ActiveWorkbook.PrintOut copies:=1
ActiveWorkbook.Close SaveChanges:=False
Nextrow:
Next r
End Sub
Please replace the existing code with the following code and let me know if that takes care of both your requirements.
The password is set on the first line as a constant string variable i.e. the password right now is nsb_500, if you want to change the password, first manually unprotect the Details Sheet with the password nsb_500 and then change the password on the first line of the code. Run the macro once and it will set the new password.
Const PW As String = "nsb_500" Private Sub CommandButton1_Click() Dim wbSource As Workbook Dim wbDest As Workbook Dim wsSource As Worksheet Dim wsDest As Worksheet Dim name As String Dim invoiceno As Long Dim paymentmethod As String Dim collectedby As String Dim item As String Dim item2 As String Dim r As Long Dim mydate As String Dim path As String Dim myfilename As String Application.ScreenUpdating = False Set wbSource = ThisWorkbook Set wsSource = wbSource.Worksheets("Details") lastrow = wsSource.Range("A" & Rows.Count).End(xlUp).Row 'Unprotecting the Details Sheet wsSource.Unprotect Password:=PW For r = 2 To lastrow If wsSource.Cells(r, 13).Value = "done" Then GoTo Nextrow If Application.CountBlank(wsSource.Range("A" & r & ":B" & r)) > 0 Then wsSource.Cells(r, 13).Value = "All the fileds are mandatory!" wsSource.Range("A" & r & ":M" & r).Locked = False ElseIf Application.CountBlank(Range("D" & r & ":K" & r)) > 0 Then wsSource.Cells(r, 13).Value = "All the fileds are mandatory!" wsSource.Range("A" & r & ":M" & r).Locked = False Else name = wsSource.Cells(r, 1).Value invoiceno = wsSource.Cells(r, 2).Value paymentmethod = wsSource.Cells(r, 4).Value collectedby = wsSource.Cells(r, 5).Value quantity = wsSource.Cells(r, 6).Value quantity2 = wsSource.Cells(r, 7).Value item = wsSource.Cells(r, 8).Value item2 = wsSource.Cells(r, 9).Value UnitPrice = wsSource.Cells(r, 10).Value UnitPrice2 = wsSource.Cells(r, 11).Value Application.DisplayAlerts = False Set wbDest = Workbooks.Open("C:\Users\Hp\Documents\receipt\receipt.xlsx") Set wsDest = wbDest.Worksheets("test") With wsDest .Range("A9").Value = quantity .Range("A10").Value = quantity2 .Range("B3").Value = name .Range("B6").Value = paymentmethod .Range("B9").Value = item .Range("B10").Value = item2 .Range("C9").Value = UnitPrice .Range("C10").Value = UnitPrice2 .Range("D3").Value = invoiceno .Range("D6").Value = collectedby End With path = "C:\Users\Hp\Documents\receipt\" mydate = Date mydate = Format(mydate, "dd_mm_yyyy") wbDest.SaveAs Filename:=path & invoiceno & " - " & name & " - " & mydate & ".xlsx" myfilename = wbDest.FullName 'SetAttr myfilename, vbReadOnly Application.DisplayAlerts = True wbDest.PrintOut copies:=1 wbDest.Close SaveChanges:=False wsSource.Cells(r, 13).Value = "done" wsSource.Range("A" & r & ":M" & r).Locked = True End If Nextrow: Next r 'Protecting the Details Sheet wsSource.Protect Password:=PW End Sub
10 Replies
- Subodh_Tiwari_sktneerSilver Contributor
Please replace the existing code with the following code and let me know if that takes care of both your requirements.
The password is set on the first line as a constant string variable i.e. the password right now is nsb_500, if you want to change the password, first manually unprotect the Details Sheet with the password nsb_500 and then change the password on the first line of the code. Run the macro once and it will set the new password.
Const PW As String = "nsb_500" Private Sub CommandButton1_Click() Dim wbSource As Workbook Dim wbDest As Workbook Dim wsSource As Worksheet Dim wsDest As Worksheet Dim name As String Dim invoiceno As Long Dim paymentmethod As String Dim collectedby As String Dim item As String Dim item2 As String Dim r As Long Dim mydate As String Dim path As String Dim myfilename As String Application.ScreenUpdating = False Set wbSource = ThisWorkbook Set wsSource = wbSource.Worksheets("Details") lastrow = wsSource.Range("A" & Rows.Count).End(xlUp).Row 'Unprotecting the Details Sheet wsSource.Unprotect Password:=PW For r = 2 To lastrow If wsSource.Cells(r, 13).Value = "done" Then GoTo Nextrow If Application.CountBlank(wsSource.Range("A" & r & ":B" & r)) > 0 Then wsSource.Cells(r, 13).Value = "All the fileds are mandatory!" wsSource.Range("A" & r & ":M" & r).Locked = False ElseIf Application.CountBlank(Range("D" & r & ":K" & r)) > 0 Then wsSource.Cells(r, 13).Value = "All the fileds are mandatory!" wsSource.Range("A" & r & ":M" & r).Locked = False Else name = wsSource.Cells(r, 1).Value invoiceno = wsSource.Cells(r, 2).Value paymentmethod = wsSource.Cells(r, 4).Value collectedby = wsSource.Cells(r, 5).Value quantity = wsSource.Cells(r, 6).Value quantity2 = wsSource.Cells(r, 7).Value item = wsSource.Cells(r, 8).Value item2 = wsSource.Cells(r, 9).Value UnitPrice = wsSource.Cells(r, 10).Value UnitPrice2 = wsSource.Cells(r, 11).Value Application.DisplayAlerts = False Set wbDest = Workbooks.Open("C:\Users\Hp\Documents\receipt\receipt.xlsx") Set wsDest = wbDest.Worksheets("test") With wsDest .Range("A9").Value = quantity .Range("A10").Value = quantity2 .Range("B3").Value = name .Range("B6").Value = paymentmethod .Range("B9").Value = item .Range("B10").Value = item2 .Range("C9").Value = UnitPrice .Range("C10").Value = UnitPrice2 .Range("D3").Value = invoiceno .Range("D6").Value = collectedby End With path = "C:\Users\Hp\Documents\receipt\" mydate = Date mydate = Format(mydate, "dd_mm_yyyy") wbDest.SaveAs Filename:=path & invoiceno & " - " & name & " - " & mydate & ".xlsx" myfilename = wbDest.FullName 'SetAttr myfilename, vbReadOnly Application.DisplayAlerts = True wbDest.PrintOut copies:=1 wbDest.Close SaveChanges:=False wsSource.Cells(r, 13).Value = "done" wsSource.Range("A" & r & ":M" & r).Locked = True End If Nextrow: Next r 'Protecting the Details Sheet wsSource.Protect Password:=PW End Sub
- nsb_500Copper Contributor
thank you very much, the Codes have worked.
however, Could you explain to me the Password Codes?
because, when i open the workbook, i can immediately start edited.- Subodh_Tiwari_sktneerSilver Contributor
You're welcome! Glad it worked as desired.
The Sheet will be protected once you run the code once and a user will not be able to edit a row in which all the fields are filled or in other words a user will not be able to edit a row where column M contains "done" after the code gets executed unless user knows the password and unprotects the sheet.