VBA Code to Create a Data Entry Form in Excel

VBA Code:

Sub CreateDataEntryForm()
    Dim ws As Worksheet
    Dim rngForm As Range
    Dim frm As UserForm
    
    ' Set the worksheet where you want to create the form
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with the desired worksheet name
    
    ' Define the range for the form fields
    Set rngForm = ws.Range("A1:B5") ' Replace "A1:B5" with the range for the form fields
    
    ' Create a new UserForm
    Set frm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Designer
    
    With frm
        ' Set the UserForm properties
        .Caption = "Data Entry Form"
        .Width = 300
        .Height = 200
        
        ' Add labels and text boxes for each form field
        For Each cell In rngForm
            With .Controls.Add("Forms.Label.1")
                .Caption = cell.Value
                .Left = 10
                .Top = (cell.Row - rngForm.Row) * 30 + 10
                .Width = 100
            End With
            
            With .Controls.Add("Forms.TextBox.1")
                .Name = "txt" & cell.Row
                .Left = 120
                .Top = (cell.Row - rngForm.Row) * 30 + 10
                .Width = 150
            End With
        Next cell
        
        ' Add a submit button
        With .Controls.Add("Forms.CommandButton.1")
            .Caption = "Submit"
            .Left = 120
            .Top = rngForm.Rows.Count * 30 + 30
            .Width = 70
            .OnClick = "SubmitData"
        End With
    End With
    
    ' Show the form
    Load frm
    frm.Show
    
    ' Clean up
    ThisWorkbook.VBProject.VBComponents.Remove frm
End Sub

Sub SubmitData()
    Dim ws As Worksheet
    Dim frm As Object
    Dim cell As Range
    
    ' Set the worksheet where the data will be entered
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with the desired worksheet name
    
    ' Set the form object
    Set frm = UserForms(0)
    
    ' Enter the form data into the worksheet
    For Each cell In ws.Range("A1:B5")
        If cell.Value <> "" Then
            cell.Offset(0, 1).Value = frm.Controls("txt" & cell.Row).Text
        End If
    Next cell
    
    ' Close the form
    Unload frm
End Sub


Check All VBA Codes

Join Our Telegram Group techguruplus telegram group Join Our WhatsApp Group techguruplus whatsapp group

Leave a Comment