How to create a data entry form on a worksheet using Activex controls to transfer data automatically to another worksheet using VBA. We can create multiple such forms on our worksheet, capture the data and analyze it quickly and easily. Watch the video below:

Watch the video on YouTube.

Here’s the complete VBA code:

Option Explicit

Function formValidation() As Boolean

cboItemName.BackColor = vbWhite
cboMfg.BackColor = vbWhite
txtBatchNo.BackColor = vbWhite
txtExpiryDate.BackColor = vbWhite
txtMRP.BackColor = vbWhite
txtPurchaseDate.BackColor = vbWhite
txtQty.BackColor = vbWhite

formValidation = True

If cboItemName.Text <> "Crocin" And cboItemName.Text <> "Cipro" And _
cboItemName.Text <> "Insulin" And cboItemName.Text <> "Cherricoff" And cboItemName.Text <> "Calmpose" Then

    MsgBox "Please select an item name from the drop-down list.", vbOKOnly + vbInformation, "Item Name"
    cboItemName.BackColor = vbRed
    cboItemName.Activate
    formValidation = False


ElseIf cboMfg.Text <> "Ranbaxy" And cboMfg.Text <> "Dabur" And cboMfg.Text <> "Sunpharma" And _
cboMfg.Text <> "Dr Reddy" And cboMfg.Text <> "Ajanta" And cboMfg.Text <> "Merck" And cboMfg.Text <> "Pfizer" Then

    MsgBox "Please select a manufacturer from the drop-down list.", vbOKOnly + vbInformation, "Item Name"
    cboItemName.BackColor = vbRed
    cboItemName.Activate
    formValidation = False


ElseIf txtBatchNo = "" Then
    MsgBox "The batch number cannot be blank.", vbOKOnly + vbInformation, "Batch No"
    txtBatchNo.BackColor = vbRed
    txtBatchNo.Activate
    formValidation = False

ElseIf txtExpiryDate.Text = "" Then
    MsgBox "The expiry date cannot be blanl.", vbOKOnly + vbInformation, "Expiry Date"
    txtExpiryDate.BackColor = vbRed
    txtExpiryDate.Activate
    formValidation = False

ElseIf txtMRP.Text = "" Then
    MsgBox "The Maximum Retail Price (MRP) cannot be blank.", vbOKOnly + vbInformation, "Maximum Retail Price (MRP)"
    txtMRP.BackColor = vbRed
    txtMRP.Activate
    formValidation = False

ElseIf txtPurchaseDate.Text = "" Then
    MsgBox "The purchase date cannot be blank.", vbOKOnly + vbInformation, "Purchase Date"
    txtPurchaseDate.BackColor = vbRed
    txtPurchaseDate.Activate
    formValidation = False

ElseIf txtQty.Text = "" Then
    MsgBox "The quantity cannot be blank.", vbOKOnly + vbInformation, "Quantity"
    txtQty.BackColor = vbRed
    txtQty.Activate
    formValidation = False

End If

End Function

Function reset()
Application.ScreenUpdating = False

Dim Obj As OLEObject

For Each Obj In ActiveSheet.OLEObjects
If TypeOf Obj.Object Is MSForms.ComboBox Or TypeOf Obj.Object Is MSForms.TextBox Then
Obj.Object.Value = “”
Obj.Object.BackColor = vbWhite
End If

Next Obj

‘cboItemName.Value = “”
‘cboItemName.BackColor = vbWhite
‘cboMfg.Value = “”
‘cboMfg.BackColor = vbWhite
‘txtBatchNo.Text = “”
‘txtBatchNo.BackColor = vbWhite
‘txtExpiryDate.Text = “”
‘txtExpiryDate.BackColor = vbWhite
‘txtMRP.Text = “”
‘txtMRP.BackColor = vbWhite
‘txtPurchaseDate.Text = “”
‘txtPurchaseDate.BackColor = vbWhite
‘txtQty.Text = “”
‘txtQty.BackColor = vbWhite

Application.ScreenUpdating = True

End Function

Private Sub cmdReset_Click()

Dim i As Integer
i = MsgBox(“Do you really wish to reset the form?”, vbQuestion + vbYesNo, “Reset Form”)
If i = vbYes Then
Call reset
End If

End Sub

Private Sub cmdSave_Click()
Application.ScreenUpdating = False

Dim nextblankRow As Long, lastrow As Long

lastrow = Sheets(“Data”).Range(“A” & Rows.Count).End(xlUp).Row

nextblankRow = lastrow + 1

If formValidation = True Then

With ThisWorkbook.Sheets("Data")

    .Range("A" & nextblankRow).Value = nextblankRow - 1
    .Range("B" & nextblankRow).Value = cboItemName.Value
    .Range("C" & nextblankRow).Value = cboMfg.Value
    .Range("D" & nextblankRow).Value = txtBatchNo.Text
    .Range("E" & nextblankRow).Value = txtExpiryDate.Text
    .Range("F" & nextblankRow).Value = txtMRP.Text
    .Range("G" & nextblankRow).Value = txtPurchaseDate.Text
    .Range("H" & nextblankRow).Value = txtQty.Text
End With

Call reset

Else

Exit Sub

End If

Application.ScreenUpdating = True

End Sub