Transfer Data from a Data Entry Form to a Protected Worksheet

In this post, we are going to learn VBA codes to transfer data from a Data Entry form to a Protected worksheet.

Watch our YouTube Tutorial

Here, I have developed a data entry application to capture Visitor details.

Home Sheet
Home page of Data Entry form

If user will click on ‘Add Visitor’s Details’ button to open the UserForm and after updating the all the fields, user needs to click on ‘Submit’ button to transfer the data from ‘Visitor Entry Form’ to ‘Home’ sheet.

Visitor Form
Visit Entry Form

Here, there could be two possibilities. Either the worksheet is protected with password or not protected. If it’s not protected then we can easily transfer the data but in case, worksheet is protected then we can’t update the data without unprotecting it.

In this file, our ‘Home’ sheet is protected hence, we need to unprotect it before transferring the data and then after updating the data to home sheet, we need to protect it again so that user can’t make any changes.

So, let’s move to the VBA window. To open VBA, you need to click on Developer Tab and then click on VBA button available in code group.

Developer Tab and VBA Button 1
Developer Tab

Once you click on Visual Basic button or press ALT + 11 as shortcut key, it will open a separate window for Visual Basic for Application.

In this project, we have 2 forms and 1 module. First form is for data entry and second is for calendar control which we have developed. You can find a separate tutorial on this.

Project
Project details

In module window, we have several Sub Procedures to perform all the required task. You see the below codes and brief explanation of all the procedures available in module window.

Code to Reset or Initialize the Visitor Data Entry Form

'Code to Reset and Initialize the form

Sub Reset_Form()

    Dim iRow As Long
    
    With frmDataEntry
    
        .txtVisitDate.Value = ""
        .txtVisitDate.BackColor = vbWhite
        
        .txtVisitorName.Value = ""
        .txtVisitorName.BackColor = vbWhite
        
                
        .optFemale.Value = False
        .optMale.Value = False
        
        .txtCompanyName.Value = ""
        .txtCompanyName.BackColor = vbWhite
        
        .txtMobile.Value = ""
        .txtMobile.BackColor = vbWhite
        
        .txtEmail.Value = ""
        .txtEmail.BackColor = vbWhite
                       
        .txtReasonOfVisit.Value = ""
        .txtReasonOfVisit.BackColor = vbWhite
        
        
    End With


End Sub

Function to Validate the Email-Id entered by User

Function ValidEmail(email As String) As Boolean


    Dim oRegEx As Object
    
    Set oRegEx = CreateObject("VBScript.RegExp")
    
    With oRegEx
    
        .Pattern = "^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}$"
        
        ValidEmail = .test(email)
        
    End With
    
    Set oRegEx = Nothing

End Function

Function to validate all the entries made by user in Visit Data Entry Form

Function ValidEntry() As Boolean

    ValidEntry = True
    
    With frmDataEntry
    
        'Default Color
        
        .txtVisitDate.BackColor = vbWhite
        .txtVisitorName.BackColor = vbWhite
        .txtCompanyName.BackColor = vbWhite
        .txtMobile.BackColor = vbWhite
        .txtEmail.BackColor = vbWhite
        .txtReasonOfVisit.BackColor = vbWhite
        
        'Validating Visit Date
        
        If Trim(.txtVisitDate.Value) = "" Then
        
            MsgBox "Visit Date is blank. Please select date from Calendar control.", vbOKOnly + vbInformation, "Visit Date"
            .txtVisitDate.BackColor = vbRed
            .txtVisitDate.SetFocus
            
            ValidEntry = False
            Exit Function
            
        End If
               
        'Validating Student's Name
        
        If Trim(.txtVisitorName.Value) = "" Then
        
            MsgBox "Please enter visitor's name.", vbOKOnly + vbInformation, "Visitor's Name"
            .txtVisitorName.BackColor = vbRed
            .txtVisitorName.SetFocus
            
            ValidEntry = False
            Exit Function
               
        End If
        
        'Validating Gender
        
        If .optFemale.Value = False And .optMale.Value = False Then
        
            MsgBox "Please select Gender.", vbOKOnly + vbInformation, "Gender"
            ValidEntry = False
            Exit Function
        
        End If
        
        'Validating Company Name
        
        If Trim(.txtCompanyName.Value) = "" Then
        
            MsgBox "Please enter Father's name.", vbOKOnly + vbInformation, "Company Name"
            .txtCompanyName.BackColor = vbRed
            .txtCompanyName.SetFocus
            
            ValidEntry = False
            Exit Function
        
        End If
        
        'Validating Mobile Number
        
        If Trim(.txtMobile.Value) = "" Or Len(.txtMobile.Value) < 10 Or Not IsNumeric(.txtMobile.Value) Then
        
            MsgBox "Please enter a valid mobile number.", vbOKOnly + vbInformation, "Mobile Number"
            .txtMobile.BackColor = vbRed
            .txtMobile.SetFocus
            
            ValidEntry = False
            Exit Function
        
        End If
        

        'Validating Email
        
        If ValidEmail(.txtEmail.Value) = False Then
        
            MsgBox "Please enter a valid email ID.", vbOKOnly + vbInformation, "Email ID"
            .txtEmail.BackColor = vbRed
            .txtEmail.SetFocus
            
            ValidEntry = False
            Exit Function
        
        End If
        
         'Validating Reason of Visit
        
        If Trim(.txtReasonOfVisit.Value) = "" Then
        
            MsgBox "Please enter Address.", vbOKOnly + vbInformation, "Address"
            .txtReasonOfVisit.BackColor = vbRed
            .txtReasonOfVisit.SetFocus
            
            ValidEntry = False
            Exit Function
        
        End If
       
    End With

End Function

Procedure to transfer the data from UserForm to worksheet

Sub Submit_Data()

    Dim iRow As Long
       
    iRow = Sheets("Home").Range("B" & Rows.Count).End(xlUp).row + 1
          
    With Sheets("Home").Range("B" & iRow)
        
        .Offset(0, 0).Value = [Row()-6]
        
        .Offset(0, 1).Value = frmDataEntry.txtVisitDate.Value
        
        .Offset(0, 2).Value = frmDataEntry.txtVisitorName.Value
        
        .Offset(0, 3).Value = frmDataEntry.txtCompanyName.Value
        
        .Offset(0, 4).Value = IIf(frmDataEntry.optFemale.Value = True, "Female", "Male")
        
        .Offset(0, 5).Value = frmDataEntry.txtMobile.Value
        
        .Offset(0, 6).Value = frmDataEntry.txtEmail.Value
        
        .Offset(0, 7).Value = frmDataEntry.txtReasonOfVisit.Value
        
        .Offset(0, 8).Value = Application.UserName
        
        .Offset(0, 9).Value = Format([Now()], "DD-MMM-YYYY HH:MM:SS")
               
    End With
    'Calling Reset function to reset the form after transferring the data    
    Call Reset_Form
    
    Application.ScreenUpdating = True
    MsgBox "Data Submitted Successfully!"

End Sub

So, all the above functions/sub procedures are available in module window.

Let’s explore all the code available in frmDataEntry UserForm.

Click event procedure of Reset button

Private Sub cmdReset_Click()

    Dim i As VbMsgBoxResult
    
    i = MsgBox("Do you want to reset the form?", vbYesNo + vbQuestion, "Reset Form")
    
    If i = vbNo Then Exit Sub
    
    Call Reset_Form
    
End Sub

Click event procedure of Calendar image to open the calendar form

Private Sub imgCalendar_Click()

    Application.ScreenUpdating = False
    
    Dim sDate As String
    
    On Error Resume Next
    
    sDate = MyCalendar.DatePicker(Me.txtVisitDate)
    
    Me.txtVisitDate.Value = Format(sDate, "dd-mmm-yyyy")
    
    On Error GoTo 0
    
    Application.ScreenUpdating = True

End Sub

Double click event for Visit Date Text box to open the Calendar form

Private Sub txtVisitDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Application.ScreenUpdating = False
    
    Dim sDate As String
    
    On Error Resume Next
    
    sDate = MyCalendar.DatePicker(Me.txtVisitDate)
    
    Me.txtDOB.Value = Format(sDate, "dd-mmm-yyyy")
    
    On Error GoTo 0
    
    Application.ScreenUpdating = True

End Sub

Code to reset the UserForm on Form Initialize event

Private Sub UserForm_Initialize()

    Call Reset_Form
    
End Sub.

In Home worksheet, we have only one sub procedure on click event of button. It will show the form.

Private Sub cmdAdd_Click()
    frmDataEntry.Show
End Sub

Now, we have fair understanding of all the procedures and functions uses in our project. In this project, only one code is pending to transfer the data on click event of Submit button in UserForm

Let’s double click on Submit Button in UserForm. It will open the code window with cmdSubmit_Click procedure.

Please see the below code to get the confirmation from user and then unprotect the sheets and transfer the data and then protect it.

Private Sub cmdSubmit_Click()

    Dim i As VbMsgBoxResult

    i = MsgBox("Do you want to submit the data?", vbYesNo + vbQuestion, "Submit Data")

    If i = vbNo Then Exit Sub

    If ValidEntry = True Then

        'Code to Unprotect the worksheet
        
        Sheets("Home").Unprotect ("thedatalabs")

        'Calling Submit_Data procedure to transfer the data from UserForm to Sheet
        Call Submit_Data
        
        'Code to Protect the worksheet

        
        Sheets("Home").Protect ("thedatalabs")

    End If

End Sub

Now, we are done with the required code. You can visit to Home sheet and run the form to transfer the data to protected sheet.

Please download the demo file used in this post.

Download
Click to download

Support File

Thanks!

1 COMMENT

  1. Hi,

    Would you please let me know how can we add email functionality in it using outlook so that user can be notified for visitor arrival on reception?

LEAVE A REPLY

Please enter your comment!
Please enter your name here

Captcha verification failed!
CAPTCHA user score failed. Please contact us!

Recommended Reads

Latest Articles