Fully Automatic Data Entry Form in excel with Print and save PDF details

 

Fully Automatic Data entry form with save pdf and print command

VBA Code File Download:- Click here

Practice File Download:- Click here

VBA Code

Module

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

'default color

.txtname.BackColor = vbWhite

.txtID.BackColor = vbWhite

.txtcont.BackColor = vbWhite

.txtdate.BackColor = vbWhite

.txtcity.BackColor = vbWhite

.cmddesg.BackColor = vbWhite

'--------------------------

.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) = "=Row()-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

Function ValidatePrintDetails() As Boolean

ValidatePrintDetails = True

Dim iEmployeeID As Variant

Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Print")

iEmployeeID = frmform.txtID.Value

With frmform

    'default color

.txtname.BackColor = vbWhite

.txtID.BackColor = vbWhite

.txtcont.BackColor = vbWhite

.txtdate.BackColor = vbWhite

.txtcity.BackColor = vbWhite

.cmddesg.BackColor = vbWhite

'--------------------------

If Trim(.txtID.Value) = "" Then

MsgBox "Please enter Employee ID .", vbOKOnly + vbInformation, "Emp ID"

ValidatePrintDetails = False

.txtID.BackColor = vbRed

.txtID.SetFocus

Exit Function

End If

If Trim(.txtname.Value) = "" Then

MsgBox "Please enter Employee name .", vbOKOnly + vbInformation, "Emp name"

ValidatePrintDetails = False

.txtname.BackColor = vbRed

.txtname.SetFocus

Exit Function

End If

'Validating Gender

If .Optfemale.Value = False And .optmale.Value = False Then

MsgBox "Please Select Gender .", vbOKOnly + vbInformation, "Gender"

ValidatePrintDetails = False

Exit Function

End If

If Trim(.cmddesg.Value) = "" Then

MsgBox "Please Select Desg .", vbOKOnly + vbInformation, "Desg"

ValidatePrintDetails = False

.cmddesg = vbRed

.cmddesg.SetFocus

Exit Function

End If

If Trim(.txtcity.Value) = "" Then

MsgBox "Please enter city .", vbOKOnly + vbInformation, "City"

ValidatePrintDetails = False

.txtcity.BackColor = vbRed

.txtcity.SetFocus

Exit Function

End If

If Trim(.txtcont.Value) = "" Then

MsgBox "Please Enter contact number.", vbOKOnly + vbInformation, "Contact"

ValidatePrintDetails = False

.txtcont.BackColor = vbRed

.txtcont.SetFocus

Exit Function

End If

If Trim(.txtdate.Value) = "" Then

MsgBox "Please enter Date of Joining .", vbOKOnly + vbInformation, "DATE"

ValidatePrintDetails = False

.txtdate.BackColor = vbRed

.txtdate.SetFocus

Exit Function

End If

End With

End Function

Sub Print_Form()

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Print")

With frmform

    sh.Range("E5").Value = .txtID.Value

    sh.Range("E7").Value = .txtname.Value

    sh.Range("E9").Value = IIf(.Optfemale.Value = True, "Female", "Male")

    sh.Range("E11").Value = .cmddesg.Value

    sh.Range("E13").Value = .txtcity.Value

    sh.Range("E15").Value = .txtcont.Value

sh.Range("E17").Value = .txtdate.Value

End With

'code to print the form or export to PDF

sh.PageSetup.PrintArea = "$B$2:$F$19"

    'Sh.PrintOut copies:= 1, IgnorePrintArea:= false

    sh.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & Application.PathSeparator & frmform.txtname.Value & ".pdf"

MsgBox "Employee details have been printed.", vbOKOnly + vbInformation, "Print"

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

********************************

Form Initialize

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 cmdPrint_Click()

Dim msgValue As VbMsgBoxResult

msgValue = MsgBox("Do you want Print Employee Details?", vbYesNo + vbInformation, "Print")

If msgValue = vbNo Then Exit Sub

If ValidatePrintDetails() = True Then

Call Print_Form

End If

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

If ValidatePrintDetails() = True Then

Call submit

Call Reset

End If

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

VBA Code File Download:- Click here

Practice File Download:- Click here