Data entry project in VBA

blog img

First we need to know how to save the file as a macro-enabled file type in Excel

> Open the Excel application

>First, go to the File tab on ribbon and then select the “Save As” option.

> After that, specify the location where you want to save this file.

>Next, we have to select “Excel Macro-Enabled Workbook” from the “Save Type As” option.

> Finally, click OK to save the file.

Now we need to create a data entry Userform. For that proceed as mentioned below

> Open the Excel application

> Right-click on the Sheet tab, then select View Code option in list.

Then the Microsoft Visual Basic application window will open.

         

After clicking the Userform option a fresh blank Userform will open.

Rename the Name and Caption of the user form as shown below.
The name acts as an ID. Caption will also be seen as the title of the user form.

Userform ToolBox



A user form should be created from the tools in the toolbox as shown below.

VBA Code for Main UserForm_Initialize

UserForm_Initialize Code
Private Sub UserForm_Initialize()
  Dim lw As Long
  Me.cmdDelete.Enabled = False
  Me.TextBox2.Visible = False
  lw = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
  activeRow = 1
  Me.ComboBox1.RowSource = "Sheet1!A2:A" & lw
End Sub

ADD  button 
In the properties window enter ‘cmdSend’ in the Add button’s name field.


Add button VBA Code

Add button VBA Code
Private Sub cmdSend_Click()
  Dim f_path As String

  f_path = ThisWorkbook.Path & "\"

  If Me.txtFirst = "" Or Me.txtSecond = "" Or Me.txtMobile = "" Then
  MsgBox "Please enter all data"
  Exit Sub
  End If

  If WorksheetFunction.CountIf(Sheets("Sheet1").Range("A:A"), Me.txtFirst.Text) > 0 Then
  MsgBox "This name already exists"
  Exit Sub
  End If


  lrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1
 
  Cells(lrow, 1).Value = txtFirst.Value
  Cells(lrow, 2).Value = txtSecond.Value
  Cells(lrow, 3).Value = txtMobile.Value

  On Error Resume Next
  FileCopy Me.TextBox2, f_path & Me.txtFirst.Text & ".jpg"

  txtFirst = ""
  txtSecond = ""
  txtMobile = ""
  Me.ComboBox1.RowSource = "Sheet1!A2:A" & lrow
  MsgBox "Data added successfully!"
 Call cmdClear_Click
End Sub
 
3 text filed name should set as mentioned below.




Clear button VBA Code

Clear button VBA Code
Private Sub cmdClear_Click()
    
    Me.txtFirst = ""
    Me.txtSecond = ""
    Me.txtMobile = ""
    Me.ComboBox1 = ""
    
    Me.Image1.Picture = Nothing
    
    Me.cmdDelete.Enabled = False
    Me.TextBox2.Visible = False
    
End Sub

ComboBox1 name set to ComboBox.

Close Button VBA Code

Close button VBA Code
Private Sub cmdClose_Click()
   Unload Me
End Sub

Previous Button VBA Code

Prev button VBA Code
Private Sub cmdPrev_Click()
    Dim namefound As Range
    fpath = ThisWorkbook.Path & "\"
     
    activeRow = activeRow - 1
    
    If activeRow > 1 Then
    
    With Cells(activeRow, 1)
    txtFirst.Text = Cells(activeRow, 1).Value
    Set namefound = .Find(txtFirst.Text)
    
    With namefound
    On Error Resume Next
    Me.Image1.Picture = LoadPicture(fpath & "no-images.jpg")
    
    Me.Image1.Picture = LoadPicture(fpath & txtFirst.Text & ".jpg")
    
    End With
    End With
    
    txtFirst.Value = Cells(activeRow, 1)
    txtSecond.Value = Cells(activeRow, 2)
    txtMobile.Value = Cells(activeRow, 3)
    
    ElseIf activeRow = 1 Then
    activeRow = activeRow + 1
    
    MsgBox "You have reached first Data"
    End If
    
    TextBox1.Value = activeRow

End Sub

Next Button VBA Code

Next button VBA Code
Private Sub cmdNext_Click()


    Dim namefound As Range
    fpath = ThisWorkbook.Path & "\"
    
    lrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    
    activeRow = activeRow + 1
    
    If activeRow = lrow + 1 Then
    activeRow = lrow
    MsgBox "You have reached last data"
    End If
    
    With Cells(activeRow, 1)
    txtFirst.Text = Cells(activeRow, 1).Value
    Set namefound = .Find(txtFirst.Text)
    
    With namefound
    On Error Resume Next
    Me.Image1.Picture = LoadPicture(fpath & "no-images.jpg")
    
    Me.Image1.Picture = LoadPicture(fpath & txtFirst.Text & ".jpg")
    
    End With
    End With
    
    txtFirst.Value = Cells(activeRow, 1).Value
    txtSecond.Value = Cells(activeRow, 2).Value
    txtMobile.Value = Cells(activeRow, 3).Value
    
    TextBox1.Value = activeRow

End Sub



Delete Button VBA Code

A prompting dialog will open when the Delete button is pressed. If you press the Yes button the desired data will be permanently deleted. If you press the No button the prompting dialog will close without deleting any data.

The VBA code associated with the delete button is as follows

Delete button VBA Code
Private Sub cmdDelete_Click()
  Dim fValue As Range
  Dim lw As Long
  Dim fpath As String
  
  fpath = ThisWorkbook.Path & "\"
  
  
   Set fValue = Sheet1.Range("A:A").Find(What:=Me.ComboBox1.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
   Select Case MsgBox("Do you want to delete " & Me.ComboBox1.Text & " Data", vbYesNo, "Delete Confirmation?")
       Case Is = vbNo
       Exit Sub
       Case Is = vbYes
    fValue.EntireRow.Delete
    On Error Resume Next
    Kill (fpath & Me.txtFirst.Text & ".jpg")
    
    
  lw = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
  Me.ComboBox1.RowSource = "Sheet1!A2:A" & lw
  
  MsgBox "Data deleted Successfully!.."
  Call cmdClear_Click
  
  
  End Select
End Sub

Update Button VBA Code

Update button VBA Code
Private Sub btnUpdate_Click()
    Dim lr As Long
    Dim f_path As String
    f_path = ThisWorkbook.Path & "\"
    
    
     Dim fValue As Range
     Set fValue = Sheet1.Range("A:A").Find(What:=Me.ComboBox1.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
     
     If Me.txtFirst = "" Or Me.txtSecond = "" Or Me.txtMobile = "" Then
       MsgBox "Please fill the all data"
       Exit Sub
       End If
       
       
       If Me.ComboBox1.Value <> Me.txtFirst.Value Then
          If Application.WorksheetFunction.CountIf(Sheet1.Range("A:A"), Me.txtFirst.Text) > 0 Then
          MsgBox Me.txtFirst.Text & " Already saved,please enter different name"
          Exit Sub
         End If
      End If
      
         fValue.Value = Me.txtFirst.Value
         fValue.Offset(0, 1).Value = Me.txtSecond.Value
         fValue.Offset(0, 2).Value = Me.txtMobile.Value
         
         
         On Error Resume Next
         FileCopy Me.TextBox2, f_path & Me.txtFirst.Text & ".jpg"
         
         lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
         
         Me.ComboBox1.RowSource = "Sheet1!A:A" & lr
         
         Call cmdClear_Click
         Me.cmdDelete.Enabled = False

End Sub



Search Button VBA Code

Search button VBA Code
Private Sub cmdSearch_Click()
    Dim fpath As String
    
    fpath = ThisWorkbook.Path & "\"
     
        If Me.ComboBox1.Value <> "" Then
           Dim Findvalue As Range
           Set Findvalue = Sheet1.Range("A:A").Find(What:=Me.ComboBox1.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
        
          If WorksheetFunction.CountIf(Sheets("Sheet1").Range("A:A"), Me.ComboBox1.Text) > 0 Then
             Me.txtFirst.Value = Findvalue.Value
             Me.txtSecond.Value = Findvalue.Offset(0, 1).Value
             Me.txtMobile.Value = Findvalue.Offset(0, 2).Value
             
             
             Me.cmdDelete.Enabled = True
        
           With Findvalue
           On Error Resume Next
           Me.Image1.Picture = LoadPicture(fpath & "No-images.jpg")
           
           Me.Image1.Picture = LoadPicture(fpath & Me.txtFirst.Text & ".jpg")
           
           
            End With
            
        End If

    End If
End Sub

Enter / Choose a name on CamboBox then press the search Button.

It will display the data related to that person who was saved earlier as shown below.

VBA Code for Insert / Change Picture button

Insert picture button VBA Code
Private Sub cmdInsert_Click()
    Dim image_path As String
    Dim image_name As String
    
    With Application.FileDialog(msoFileDialogOpen)
    
    .InitialFileName = ThisWorkbook.Path
    .Filters.Clear
    .Filters.Add "JPEG", "*.jpg, *.jpeg"
    .Title = "Insert Image"
    .ButtonName = "Choose Image"
    .AllowMultiSelect = False
    
    If .Show = True Then
    Me.TextBox2.Visible = True
       image_path = .SelectedItems(1)
       Me.TextBox2.Text = image_path
       Me.Image1.Picture = LoadPicture(image_path)
       
    Else
      MsgBox "Image not selected"
     End If
   End With
    
End Sub

When the Insert Image button is clicked, the Insert Image Title window opens as shown below.

If you don’t select any image, the alert massage will show as below.

When you select any image, VBA displays the image you selected in the ImageControl and displays the image path in the TextView.
Same as below image.



VBA Code for Search Type ( Option Buttons)

> Search Type First name

First name Option click > VBA Code

Private Sub opbFirst_Click()
 Dim lw As Long
 Me.ComboBox1 = ""
 lw = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
 Me.ComboBox1.RowSource = "Sheet1!A2:A" & lw
End Sub

> Search Type Mobile

Mobile Option click > VBA Code

Private Sub opbMobile_Click()
    Dim lw As Long
    Me.ComboBox1 = ""
    lw = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    Me.ComboBox1.RowSource = "Sheet1!C2:C" & lw
End Sub

 

VBA code for ‘Vew All Data’ button of data entry userform

This code only call the next userForm.

View All Data button VBA Code
Private Sub cmdAllData_Click()
 UserForm1.Show
End Sub

The blue window is ‘ListBox’, the listbox is indicated as ListBox1

The Close button is specified as ‘cmdClose’

All Data UserForm_Initializing VBA Code

UserForm_Initialize code
Private Sub UserForm_Initialize()
  Dim lw As Long
  lw = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
  Me.ListBox1.RowSource = "Sheet1!A2:C" & lw
End Sub

Shows all the data to the user through a ListBox

VBA Code for double-clicking a ListBox’s list item

list item double click code
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

   Dim li As Long
   Dim fpath As String
   Dim Findvalue As Range
   
   
   fpath = ThisWorkbook.Path & "\"
   
   li = Me.ListBox1.ListIndex
   
   frmProject.txtFirst.Value = Me.ListBox1.List(li, 0)
   frmProject.txtSecond.Value = Me.ListBox1.List(li, 1)
   frmProject.txtMobile.Value = Me.ListBox1.List(li, 2)
   
   On Error Resume Next
   frmProject.Image1.Picture = LoadPicture(fpath & "no-images.jpg")
   
   frmProject.Image1.Picture = LoadPicture(fpath & frmProject.txtFirst.Text & ".jpg")
   
   Unload Me
End Sub

VBA code for All Data UserForm Close button

Close button code

Private Sub cmdClose_Click()
  Unload Me
End Sub

 

Share your thoughts

Your email address will not be published. All fields are required.