Blog Posts

Transfer Data from a Data Entry Form to a Protected Worksheet

December 1, 2021

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.

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.

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.

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.

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

'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 = "^&#91;\w-\.]{1,}\@(&#91;\da-zA-Z-]{1,}\.){1,}&#91;\da-zA-Z-]{2,3}$"
        
        ValidEmail = .test(email)
        
    End With
    
    Set oRegEx = Nothing

End Function

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) &lt; 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

100

101

102

103

104

105

106

107

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" &amp; Rows.Count).End(xlUp).row + 1
          
    With Sheets("Home").Range("B" &amp; iRow)
        
        .Offset(0, 0).Value = &#91;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(&#91;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

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

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

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

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.

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

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

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.

Support File

Thanks!

Share on Facebook

Run UserForm without showing the Excel Application

Scrolling Chart in Excel