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
You're welcome again! Glad it is working as desired now.
Subodh_Tiwari_sktneer Dear Mr Tiwari
As I continue to Develop this Mini-Project, I came across Searchable dropdown Lists from youtube
Create a searchable drop down list in Excel By Neil Firth
https://www.youtube.com/watch?v=vkPoViUhkxU
Create a searchable drop down list in Excel Part 2 by Neil Firth
https://www.youtube.com/watch?v=0QrQT9D25Xk
Now, I have applied this to the workbook
however, when I close the workbook and reopen it, the Functionality of this based on the videos fails to work
I have used 2 sheets for this.
Could you have a look at it and possible assist or have a solution to it?
I have attached the workbook