Fully Automatic Data Entry Form in excel VBA

 

Fully Automatic Data Entry Form With Search Data, Edit Data and Delete Data

Download Excel Project File:- Click here

Download VBA Code Notepad File:- Click here

Copy Code Here

Option Explicit

Sub Reset()

Dim i As Long

i = [Counta(Database!A:A)]

With frmform

.txtname.Value = ""

.txtID.Value = ""

.txtcont.Value = ""

.txtdate.Value = ""

.txtcity.Value = ""

.optmale.Value = False

.Optfemale.Value = False

 .cmddesg.Clear

.cmddesg.AddItem "Manager"

.cmddesg.AddItem "Accountant"

.cmddesg.AddItem "Supervisor"

.cmddesg.AddItem "Peon"

.cmddesg.AddItem "Cleark"

.txtRowNumber.Value = ""

'here this code is related with search feature

Call Add_SearchColumn

        ThisWorkbook.Sheets("Database").AutoFilterMode = False

        ThisWorkbook.Sheets("SearchData").AutoFilterMode = False

        ThisWorkbook.Sheets("SearchData").Cells.Clear

'************

.Lstdatabase.ColumnCount = 8

.Lstdatabase.ColumnHeads = True

.Lstdatabase.ColumnWidths = "30,68,80,75,75,55,50,55"

If i > 1 Then

.Lstdatabase.RowSource = "Database!A2:H" & i

Else

.Lstdatabase.RowSource = "Database!A2:H2"

End If

End With

End Sub

Sub submit()

Dim sh As Worksheet

Dim i As Long

Set sh = ThisWorkbook.Sheets("Database")

 

If frmform.txtRowNumber.Value = "" Then

i = [Counta(Database!A:A)] + 1

Else

    i = frmform.txtRowNumber.Value

    End If

   

With sh

.Cells(i, 1) = i - 1

.Cells(i, 2) = frmform.txtname.Value

.Cells(i, 3) = frmform.txtID.Value

.Cells(i, 4) = frmform.txtcont.Value

.Cells(i, 5) = frmform.txtdate.Value

.Cells(i, 6) = frmform.txtcity.Value

.Cells(i, 7) = IIf(frmform.Optfemale.Value = True, "Female", "Male")

.Cells(i, 8) = frmform.cmddesg.Value

End With

 

End Sub

Sub show_form()

frmform.Show

End Sub

Function selected_List() As Long

Dim E As Long

selected_List = 0

For E = 0 To frmform.Lstdatabase.ListCount - 1

If frmform.Lstdatabase.Selected(E) = True Then

selected_List = E + 1

Exit For

End If

Next E

End Function

Sub Add_SearchColumn()

frmform.EnableEvents = False

With frmform.cmdSearchColumn

    .Clear

    .AddItem "All"

.AddItem "Emp Name"

.AddItem "Emp ID"

.AddItem "Contact"

.AddItem "DOJ"

.AddItem "City"

.AddItem "Gender"

.AddItem "Desg"

.Value = "All"

End With

frmform.EnableEvents = True

frmform.txtSearch.Value = ""

frmform.txtSearch.Enabled = False

frmform.cmdSearch.Enabled = False

End Sub

 

Sub SearchData()

Application.ScreenUpdating = False

 

Dim shDatabase As Worksheet 'Database sheet

Dim shSearchData As Worksheet 'search datasheet

 

Dim iColumn As Integer 'tohold the selected column number in data sheet

Dim iDatabaseRow As Long 'to store the last non-blank row number available in database

Dim iSearchRow As Long 'to hold the last non-blank row number available in SearchData sheet

 

Dim sColumn As String 'to store the column selection

Dim sValue As String 'to hold the search text value

 

Set shDatabase = ThisWorkbook.Sheets("Database")

Set shSearchData = ThisWorkbook.Sheets("searchData")

iDatabaseRow = ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp).Row

 

sColumn = frmform.cmdSearchColumn.Value

sValue = frmform.txtSearch.Value

iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:H1"), 0)

'Remove filter from database worksheet

If shDatabase.FilterMode = True Then

shDatabase.AutoFilterMode = False

End If

'apply filter on database worksheet

If frmform.cmdSearchColumn.Value = "Emp Name" Then

shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue

Else

shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"

End If

If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("B:B")) >= 2 Then

 

'code to remove the previous Date from search data worksheet

 

shSearchData.Cells.Clear

shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")

Application.CutCopyMode = False

iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).Row

frmform.Lstdatabase.ColumnCount = 8

frmform.Lstdatabase.ColumnWidths = "30,68,80,75,75,55,50,55"

If iSearchRow > 1 Then

frmform.Lstdatabase.RowSource = "SearchData!A2:H" & iSearchRow

MsgBox "Record Found."

End If

Else

MsgBox "No Record Found."

End If

shDatabase.AutoFilterMode = False

Application.ScreenUpdating = True

End Sub

‘*************************************

Option Explicit

Public EnableEvents As Boolean

Private Sub cmdcancel_Click()

Dim msgValue As VbMsgBoxResult

msgValue = MsgBox("Do you want to reset it?", vbYesNo + vbInformation, "Confirmation")

If msgValue = vbNo Then Exit Sub

Call Reset

End Sub

Private Sub cmdDelete_Click()

Dim iRow As Long

If selected_List = 0 Then

   

        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Delete"

        Exit Sub

    End If

    Dim i As VbMsgBoxResult

    i = MsgBox("Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")

    If i = vbNo Then Exit Sub

    iRow = Application.WorksheetFunction.Match(Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 0), ThisWorkbook.Sheets("Database").Range("A:A"), 0)

    ThisWorkbook.Sheets("Database").Rows(iRow).Delete

    Call Reset

    MsgBox "Selected record has been deleted.", vbOKOnly + vbInformation, "Deleted"

End Sub

Private Sub cmddesg_Change()

Me.txtID.Value = "Reg-" & Left(Me.cmddesg, 2) & Me.txtdate.Value

End Sub

 

Private Sub cmdEdit_Click()

If selected_List = 0 Then

MsgBox "No Row is selected.", vbOKOnly + vbInformation, "Edit"

Exit Sub

End If

'this code to update the value to respective contors

Dim gender As String

Me.txtRowNumber.Value = Application.WorksheetFunction.Match(Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 0), ThisWorkbook.Sheets("Database").Range("A:A"), 0)

 

Me.txtname.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 1)

Me.txtID.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 2)

Me.txtcont.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 3)

Me.txtdate.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 4)

Me.txtcity.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 5)

gender = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 6)

If gender = "Female" Then

    Me.Optfemale.Value = True

Else

Me.optmale.Value = True

End If

Me.cmddesg.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 7)

MsgBox "Please make th erequired changes and click on 'save' button to update.", vbOKOnly + vbInformation, "Edit"

End Sub

Private Sub cmdsave_Click()

Dim msgValue As VbMsgBoxResult

msgValue = MsgBox("Do you want to save it?", vbYesNo + vbInformation, "Confirmation")

If msgValue = vbNo Then Exit Sub

Call submit

Call Reset

End Sub

Private Sub cmdSearch_Click()

If Me.txtSearch.Value = "" Then

MsgBox "Please enter the search value.", vbOKOnly + vbInformation, "Search"

Exit Sub

End If

Call SearchData

End Sub

Private Sub cmdSearchColumn_Change()

If Me.EnableEvents = False Then Exit Sub

    If Me.cmdSearchColumn.Value = "All" Then

    Call Reset

Else

    Me.txtSearch.Value = ""

    Me.txtSearch.Enabled = True

    Me.cmdSearch.Enabled = True

End If

End Sub

Private Sub txtdate_Change()

Me.txtID.Value = "Reg-" & Left(Me.cmddesg, 2) & Me.txtdate.Value

End Sub

Private Sub UserForm_Initialize()

Call Reset

End Sub

Download Excel Project File:- Click here

Download VBA Code Notepad File:- Click here