Click here to download this file
Fully Automatic Data Entry userform in Excel VBA || Employee Database in Excel VBA
Full vba code I shared here for your references. You can follow it
- Option Explicit
- ------------------------------------------------------------------
- Private Sub UserForm_Initialize()
- Me.ComboBox1.AddItem "EMP-ID"
- Me.ComboBox1.AddItem "CONTACT NO"
- End Sub
- Private Sub TextBox1_Change()
- Me.TextBox1 = UCase(Me.TextBox1)
- End Sub
- Private Sub TextBox2_Change()
- Me.TextBox2 = UCase(Me.TextBox2)
- End Sub
- Private Sub TextBox3_Change()
- Me.TextBox3 = UCase(Me.TextBox3)
- End Sub
- Private Sub TextBox4_AfterUpdate()
- Me.TextBox4.Value = Format(Me.TextBox4, "dd-mmm-yy")
- End Sub
- Private Sub TextBox5_Change()
- Me.TextBox5 = UCase(Me.TextBox5)
- End Sub
- Private Sub TextBox6_AfterUpdate()
- Me.TextBox6.Text = Format(Me.TextBox6.Text, "000-000-0000")
- End Sub
- Private Sub TextBox8_Change()
- Me.TextBox8 = UCase(Me.TextBox8)
- End Sub
- Private Sub TextBox9_AfterUpdate()
- Me.TextBox9.Value = Format(Me.TextBox9, "dd-mmm-yy")
- End Sub
- ===============================================
- Private Sub CommandButton1_Click()
- ''**************CODES for Add Button****************
- If Me.Image1.Picture Is Nothing Then
- MsgBox "Please Insert Image First"
- Exit Sub
- End If
- '----------DEFINE WORKSHEET WHERE YOU ARE WORKING---
- Dim sh As Worksheet
- Set sh = Sheets("SHEET1")
- sh.Unprotect "121"
- '---------------TO FIND OUT LAST ROW---------------
- Dim i As Long
- i = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
- '' ----------NOW PREVENT DUPLICATE ENTRY-----------
- Dim m As Long
- For m = 3 To i
- If Application.WorksheetFunction.CountIf(sh.Range("G3", "G" & m), Me.TextBox6.Value) > 0 Then
- MsgBox "DUPLICATE ITEM, PLEASE TRY ANOTHER"
- Exit Sub
- End If
- Next m
- '-----------------------------------------------
- '' mandatory field
- Dim n As Integer
- For n = 1 To 9
- If Me("TextBox" & n).Value = "" Then
- MsgBox "All field are mandatory"
- Exit Sub
- End If
- Next n
- '------------TRANSFERING DATA---------------------
- '' emp id
- sh.Cells(i, 1) = Me.TextBox1.Value & "_00" & i
- Dim x As Integer
- For x = 1 To 9
- sh.Cells(i, x + 1) = Me("TextBox" & x).Value
- Next x
- ''''----------Call image_transfer------------------
- Call image_transfer
- '-------------------------------------------------
- sh.Protect "121"
- MsgBox "DATA TRANSFERED SUCCESSFUL"
- '------------RESET THE FORM-----------------------
- Call CommandButton5_Click
- End Sub
- ===============================================
- Private Sub CommandButton2_Click()
- '***************CODES for Update*****************
- Dim sh As Worksheet
- Set sh = Sheets("Sheet1")
- '------------------------------------------------
- sh.Unprotect "121"
- '----TO FIND OUT THAT ROW WHICH IS BEING EDITED------
- Dim i As Long
- For i = 3 To sh.Range("A" & Rows.Count).End(xlUp).Row
- '----------------------------------------------------
- '-----DATA WILL SEARCH BY THE VALUE OF TEXTBOX10-----
- If Me.TextBox10.Value = sh.Cells(i, 1) Then
- '' Here if you want to search from HSN CODE i.e Column B then 2,
- Dim x As Integer
- '------NOW EDIT WILL MADE----------------------------
- For x = 1 To 9
- sh.Cells(i, x + 1) = Me("TextBox" & x).Value
- On Error Resume Next
- '--------PREVIOUS PIC WILL BE DELETED----------------
- ActiveSheet.Shapes.Range(Array("IMAGE_" & i)).Select
- Selection.Delete
- Next x
- End If
- Next i
- '------------------------------------------------------
- Call image_transfer 'NOW NEW PIC WILL BE PLACED
- '------------------------------------------------------
- sh.Protect "121"
- MsgBox "EDITED SUCCESSFUL"
- '-----------------------------------------------------
- Call CommandButton5_Click 'RESET THE FORM
- End Sub
- ===================================================
- Private Sub CommandButton3_Click()
- '' FOR DELETE ROW
- Dim sh As Worksheet
- Set sh = Sheets("Sheet1")
- sh.Unprotect "121"
- '----TO FIND OUT THAT ROW WHICH IS BEING EDITED------
- Dim i As Long
- For i = 3 To sh.Range("A" & Rows.Count).End(xlUp).Row
- '---------------DELETE SELECTED ROW------------------
- If Me.TextBox10.Value = sh.Cells(i, 1) Then
- sh.Cells(i, 1).EntireRow.Delete
- '------------- TO delete image----------------------
- On Error Resume Next
- ActiveSheet.Shapes.Range(Array("IMAGE_" & i)).Select
- Selection.Delete
- End If
- Next i
- '--------------------------------------------------
- sh.Protect "121"
- MsgBox "DELETED SUCCESSFUL"
- Call CommandButton5_Click 'RESET THE FORM
- Me.TextBox10.Enabled = True
- Me.TextBox10 = ""
- Me.CommandButton4.Enabled = True 'ENABLE CLICK TO EDIT BUTTON
- End Sub
- ==============================================
- Private Sub CommandButton4_Click()
- '************click to Edit Button**********************
- If Me.TextBox10 = "" Then Exit Sub
- '---------- DISABLED ADD BUTTON---------------------
- Me.CommandButton1.Enabled = False
- '----SELECT THE ROW OF LISTBOX------------------
- Dim r As Long
- For r = 0 To Me.ListBox1.ListCount - 1
- If Me.ListBox1.Selected(r) = True Then
- '-------------Data Transfer from ListBox To TextBoxes----
- Dim x As Integer
- For x = 1 To 9
- Me("TextBox" & x).Value = Me.ListBox1.Column(x)
- Next x
- End If
- Next r
- '------------------------------------------------------
- On Error Resume Next
- '-----EDIT, DELETE WILL MADE FOR TEXTBOX10'S VALUE------
- Me.TextBox10.Value = Me.ListBox1.Column(0)
- Me.TextBox10.Enabled = False
- '----------- LOAD searchED image---------------------
- Dim ipath As String
- ipath = "C:\MY FOLDER\" & Me.TextBox10 & ".jpg"
- Me.Image1.Picture = LoadPicture(ipath)
- Me.Image1.PictureSizeMode = fmPictureSizeModeStretch
- '' Disable "Click To Edit" Button
- Me.CommandButton4.Enabled = False
- End Sub
- ==================================================
- Private Sub CommandButton5_Click()
- '************RESET BUTTON********************
- Dim x As Integer
- For x = 1 To 10
- Me("TextBox" & x).Value = ""
- Next x
- Me.CommandButton4.Enabled = True
- On Error Resume Next
- Me.Image1.Picture = LoadPicture(vbNullString)
- End Sub
- ==============================================
- Private Sub CommandButton6_Click()
- '*************ADD PHOTO BUTTON***************************
- On Error Resume Next
- Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
- Application.FileDialog(msoFileDialogOpen).Show '' to show browse box
- '-----------TO SELECT IMAGE SOURCE PATH---------------------
- Dim filepath As String
- filepath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
- '------------LOAD FROM SOURCE PATH-------------------
- Me.Image1.Picture = LoadPicture(filepath)
- Me.Image1.PictureSizeMode = fmPictureSizeModeStretch
- '------------------SUBSCRIBE MY CHANNEL-------------------
- End Sub
- Private Sub CommandButton7_Click()
- Unload Me
- End Sub
- =======================================================
- Private Sub TextBox10_Change()
- '********* LOAD LISTBOX WHEN WE TYPING ON THIS TEXTBOX************
- '-------FORMAT TEXTBOX AS UPPER/LOWER CASE---------------------
- Me.TextBox10.Value = UCase(Me.TextBox10)
- '--------CLEAR LISTBOX EVERYTIME WHEN CLICK-------------------
- Me.ListBox1.Clear
- '------------------------------------------------------
- Dim SHT As Worksheet
- Set SHT = Sheets("SHEET1")
- Dim b, a As Integer
- '-----TO SELECT COLUMN NUMBER--FROM COMBOBOX--------
- If Me.ComboBox1.Value = "EMP-ID" Then b = 1
- If Me.ComboBox1.Value = "CONTACT NO" Then b = 7
- '--------TO FIND OUT THE ROW NUMBER----------------
- Dim i, x As Long
- For i = 3 To SHT.Range("A" & Rows.Count).End(xlUp).Row
- '----SHOW MSGBOX IF COMBOBOX BLANK--------------
- If Me.ComboBox1.Value = "" Then
- MsgBox "SELECT CRITERIA"
- Exit Sub
- End If
- '------------------------------------------------
- '-------------TO COUNT CHARECTERS OF COLUMN'S CELL-------
- For x = 1 To Len(SHT.Cells(i, b))
- '------TO COUNT TEX------------------------------
- a = Me.TextBox10.TextLength
- '------NOW APLLY CONDITION-------------------------
- If UCase(Mid(SHT.Cells(i, b), x, a)) = Me.TextBox10 And Me.TextBox10 <> "" Then
- 'NOW LOAD LISBOX BASED ON ABOVE COND----------------------------
- With Me.ListBox1
- .AddItem SHT.Cells(i, 1)
- .List(.ListCount - 1, 1) = SHT.Cells(i, 2)
- .List(.ListCount - 1, 2) = SHT.Cells(i, 3)
- .List(.ListCount - 1, 3) = SHT.Cells(i, 4)
- .List(.ListCount - 1, 4) = SHT.Cells(i, 5)
- .List(.ListCount - 1, 5) = SHT.Cells(i, 6)
- .List(.ListCount - 1, 6) = SHT.Cells(i, 7)
- .List(.ListCount - 1, 7) = SHT.Cells(i, 8)
- .List(.ListCount - 1, 8) = SHT.Cells(i, 9)
- .List(.ListCount - 1, 9) = SHT.Cells(i, 10)
- End With
- End If
- Next x
- Next i
- '------------NSUTRADHAR--------------------------------
- End Sub
- ===========================================
- Sub RectangleRoundedCorners1_Click()
- Emp_Database_frm.Show
- End Sub
- ===========================================
- Sub image_transfer()
- If Emp_Database_frm.TextBox1 = "" Then Exit Sub
- Dim sh As Worksheet
- Set sh = Sheets("Sheet1")
- Dim i As Long
- i = sh.Range("A" & Rows.Count).End(xlUp).Row
- '' to copy image from userform & paste it with resize
- Dim filepath As String
- filepath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
- sh.Cells(i, "K").Select
- sh.Range("K" & i).RowHeight = 40
- sh.Range("K" & i).ColumnWidth = 13
- sh.Cells(i, "K") = sh.Pictures.Insert(filepath).Select
- Selection.ShapeRange.Name = "IMAGE_" & i
- Selection.ShapeRange.ScaleWidth 0.3, msoFalse, msoScaleFromTopLeft
- Selection.ShapeRange.ScaleHeight 0.3, msoFalse, msoScaleFromTopLeft
- '' to copy the image and save it on a folder
- Dim ipath As String
- ipath = "C:\MY FOLDER\" & Emp_Database_frm.TextBox1 & "_00" & i & ".jpg"
- FileCopy filepath, ipath
- '' now paste the hyperlink of the image
- sh.Cells(i, "L").Select
- ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=ipath, TextToDisplay:=Emp_Database_frm.TextBox1.Value
- Emp_Database_frm.Image1.Picture = LoadPicture(vbNullString)
- End Sub
For Support and FeedBack
You can share your feedback through this blogs or can contact through email if you have any queries regarding any excel related file. Thanks for visiting this blogs.
Please send the file
ReplyDeleteI provide the download link. Please see download link
DeletePLEASE SHARE PASSWORD TO UNPROTECT EXCEL FILE
Delete121
DeletePlease excel file send me
ReplyDeleteGreat job sir keep it up really enjoyed your work and found the ucase as additional for my template in which you already worked and make it easy for me hope the teaching and learning process will be continue onward and once again bundleeee Of thanks
ReplyDeletePlease send the file
ReplyDeleteI provide the download link. Please see download link
DeletePlease send the file
ReplyDeleteRealy appreciable wok sir
ReplyDeleteGreat job
ReplyDeletePlease kindly send the file
thank you
I provide the download link. Please see download link
DeletePls can you send the link through mail?
ReplyDeleteMany people ask you about:
ReplyDeletePLEASE SHARE PASSWORD TO UNPROTECT EXCEL FILE
Can you? Then why we can download without do something...
password is 121
Delete