Forum Discussion
assistance in VBA that will enable me to have mandatory fields and lock rows when complete
- Mar 16, 2020
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
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_500Mar 17, 2020Copper 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_sktneerMar 17, 2020Silver 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.
- nsb_500Mar 18, 2020Copper Contributor
Subodh_Tiwari_sktneer Dear Sir,
kindly assist with a workbook with this codes functioning. I have tried on my side and it doesn't seem to apply what you have described.Thank you