Forum Discussion

nsb_500's avatar
nsb_500
Copper Contributor
Mar 16, 2020
Solved

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

  • nsb_500 

    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

  • nsb_500 

    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_500's avatar
      nsb_500
      Copper Contributor

      Subodh_Tiwari_sktneer 

      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_sktneer's avatar
        Subodh_Tiwari_sktneer
        Silver Contributor

        nsb_500 

        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.

Resources