Excel VBA DataEntry Software Project Beginner to Advance | Data Entry, Search, Update, Print in Excel

Excel VBA DataEntry Software Project Beginner to Advance | Data Entry, Search, Update, Print in Excel

This is UserForm1 Code

'yah Userform1 ka code hai
Private Sub cmdLogin_Click()
Dim ws As Worksheet
Dim logSheet As Worksheet
Dim lastRow As Long
Dim i As Long
Dim isAuthenticated As Boolean
Dim username As String, password As String
Dim role As String

' Set up variables
username = Trim(txtUsername.Value)
password = Trim(txtPassword.Value)
isAuthenticated = False

' Reference the login sheet (Sheet3)
Set ws = ThisWorkbook.Sheets("Sheet3")
Set logSheet = ThisWorkbook.Sheets("Sheet4")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' Validate input
If username = "" Or password = "" Then
    lblMessage.Caption = "Please enter both Username and Password."
    lblMessage.ForeColor = vbRed
    Exit Sub
End If

' Loop through the user database to validate credentials
For i = 2 To lastRow ' Assuming row 1 contains headers
    If ws.Cells(i, 1).Value = username And ws.Cells(i, 2).Value = password Then
        isAuthenticated = True
        role = ws.Cells(i, 3).Value ' Assuming column C stores roles
        Exit For
    End If
Next i

' Check login status
If isAuthenticated Then
    lblMessage.Caption = "Login Successful!"
    lblMessage.ForeColor = vbGreen

    ' Adjust Sheet visibility based on Role
    Dim wsSheet As Worksheet
    If role = "Admin" Then
        MsgBox "Welcome Admin! You have full access.", vbInformation
        ' Show all sheets for Admin
        For Each wsSheet In ThisWorkbook.Sheets
            wsSheet.Visible = xlSheetVisible
        Next wsSheet
    Else
        MsgBox "Welcome User! You have limited access.", vbInformation
        ' Hide Sheet3 and Sheet4 for Users
        For Each wsSheet In ThisWorkbook.Sheets
            If wsSheet.Name = "Sheet3" Or wsSheet.Name = "Sheet4" Then
                wsSheet.Visible = xlSheetVeryHidden
            Else
                wsSheet.Visible = xlSheetVisible
            End If
        Next wsSheet
    End If

    ' Log the login in Sheet4
    With logSheet
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lastRow, 1).Value = username ' Username
        .Cells(lastRow, 2).Value = Date ' Login Date
        .Cells(lastRow, 3).Value = Time ' Login Time
        .Cells(lastRow, 4).Value = role ' Role
        .Cells(lastRow, 5).Value = "In Progress" ' Duration Placeholder
        .Cells(lastRow, 6).Value = "" ' Logout Date Placeholder
        .Cells(lastRow, 7).Value = "" ' Logout Time Placeholder
    End With

    ' Save login details in the current form for logout tracking
    Me.Tag = CStr(lastRow) ' Store the row number in the form's Tag property

    ' Open UserForm2 as modeless
    Me.Hide
    UserForm2.Show vbModeless ' Modeless UserForm2 to allow interaction with Excel

Else
    lblMessage.Caption = "Invalid Username or Password."
    lblMessage.ForeColor = vbRed
End If

End Sub
'End ka Userform1 Code

Yah Userform2 ka code hai

'Yah Userform2 ka Code Hai
Private Sub cmdExcelOn_Click()
Application.Visible = True
End Sub

Private Sub cmdExit_Click()
Application.Quit
End Sub

Private Sub cmdLogout_Click()
Dim logSheet As Worksheet
Dim logRow As Long
Dim loginTime As Date
Dim logoutTime As Date
Dim duration As String

' Restore Excel visibility
Application.Visible = True

' Reference the log sheet (Sheet4)
Set logSheet = ThisWorkbook.Sheets("Sheet4")

' Retrieve the row number from the form's Tag property
logRow = Val(UserForm1.Tag)
If logRow > 0 Then
    With logSheet
        loginTime = .Cells(logRow, 3).Value + .Cells(logRow, 2).Value ' Combine date and time
        logoutTime = Now ' Current date and time

        ' Calculate duration
        duration = Format(logoutTime - loginTime, "hh:mm:ss")

        ' Update log details
        .Cells(logRow, 5).Value = duration ' Duration
        .Cells(logRow, 6).Value = Date ' Logout Date
        .Cells(logRow, 7).Value = Time ' Logout Time
    End With
End If

' Reset sheet visibility: Sheet3 and Sheet4 hidden by default
Dim wsSheet As Worksheet
For Each wsSheet In ThisWorkbook.Sheets
    If wsSheet.Name = "Sheet3" Or wsSheet.Name = "Sheet4" Then
        wsSheet.Visible = xlSheetVeryHidden ' Hide Sheet3 and Sheet4
    Else
        wsSheet.Visible = xlSheetVisible ' Show other sheets
    End If
Next wsSheet

' Close current form and return to login form
Unload Me
UserForm1.Show

End Sub

Private Sub UserForm_Initialize()
' Initialize automatic SR No, Date, Time, Gender Radio Buttons, and Course ComboBox

' Auto populate Date and Time
txtDate.Value = Date
txtTime.Value = Time

' Auto populate SR No (last entry + 1)
Dim lastRow As Long
Dim lastCellValue As Variant

' Find the last row with data in Column A
lastRow = ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row

' If lastRow is 0 (i.e., no data), set to 1
If lastRow = 1 And IsEmpty(ThisWorkbook.Sheets("Sheet1").Cells(lastRow, 1).Value) Then
    lastRow = 0 ' Set to 0 if the first cell is empty
End If

' Check if lastRow is a valid value
If lastRow > 0 Then
    lastCellValue = ThisWorkbook.Sheets("Sheet1").Cells(lastRow, 1).Value

    ' If lastRow has a value, increment it
    If IsNumeric(lastCellValue) Then
        txtSrNo.Value = lastCellValue + 1
    Else
        ' If the last cell is not numeric, set SR No to 1
        txtSrNo.Value = 1
    End If
Else
    ' If lastRow is 0, start from SR No 1
    txtSrNo.Value = 1
End If

' Populate Course ComboBox
comboCourse.AddItem "ADCA"
comboCourse.AddItem "DFA"
comboCourse.AddItem "DCA"
comboCourse.AddItem "O Level"

' Set default Gender Radio Buttons
optMale.Value = True

End Sub

Private Sub txtMobile_Exit(ByVal Cancel As MSForms.ReturnBoolean)
' Validate Mobile Number (10 digits)
If Len(txtMobile.Value) <> 10 Or Not IsNumeric(txtMobile.Value) Then
MsgBox "Please enter a valid 10-digit mobile number.", vbCritical
txtMobile.SetFocus
Cancel = True
End If
End Sub

' ComboCourse ke selection ke liye code
Private Sub ComboCourse_Change()
' Automatically calculate Course Fees and Offer Fees (50% off)
Dim courseFees As Double
Select Case comboCourse.Value
Case "ADCA"
courseFees = 16000
Case "DFA"
courseFees = 12000
Case "DCA"
courseFees = 13000
Case "O Level"
courseFees = 20000
Case Else
courseFees = 0
End Select

' Set Course Fees and Offer Fees
txtCourseFees.Value = courseFees ' Show course fees in txtCourseFees
txtOfferFees.Value = courseFees * 0.5 ' 50% off in txtOfferFees

End Sub

' Jab txtPaidFees change ho tab due fees calculate ho
Private Sub txtPaidFees_Change()
' Validate Paid Fees
If IsNumeric(txtPaidFees.Value) And IsNumeric(txtOfferFees.Value) Then
Dim dueFees As Double
dueFees = Val(txtOfferFees.Value) - Val(txtPaidFees.Value)
txtDueFees.Value = dueFees
Else
txtDueFees.Value = "0" ' Default value if input is not numeric
End If
End Sub

Private Sub cmdSubmit_Click()
' Validate all fields before submitting
If txtName.Value = "" Or txtFatherName.Value = "" Or txtMobile.Value = "" Or comboCourse.Value = "" Or txtPaidFees.Value = "" Then
MsgBox "Please fill all required fields.", vbExclamation
Exit Sub
End If

' Add data to Sheet1

Dim lastRow As Long
Dim currentUser As String

' Retrieve logged-in username from UserForm1
currentUser = UserForm1.txtUsername.Value

lastRow = ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row + 1

With ThisWorkbook.Sheets("Sheet1")
' Add values to the row
.Cells(lastRow, 1).Value = txtSrNo.Value
.Cells(lastRow, 2).Value = txtDate.Value
.Cells(lastRow, 3).Value = txtTime.Value
.Cells(lastRow, 4).Value = txtName.Value
.Cells(lastRow, 5).Value = txtFatherName.Value
.Cells(lastRow, 6).Value = txtMobile.Value
.Cells(lastRow, 7).Value = comboCourse.Value
.Cells(lastRow, 8).Value = IIf(optMale.Value, "Male", "Female")
.Cells(lastRow, 9).Value = txtOfferFees.Value
.Cells(lastRow, 10).Value = txtPaidFees.Value
.Cells(lastRow, 11).Value = txtDueFees.Value' Save Entry Role (logged-in user)
.Cells(lastRow, 13).Value = currentUser ' Column M: Entry Role

' Save current timestamp for entry
.Cells(lastRow, 15).Value = Date ' Column O: Update Date
.Cells(lastRow, 16).Value = Time ' Column P: Update Time

' Save the photo path (from hidden textbox)
If txtPhotoPath.Value <> "" Then
    .Cells(lastRow, 12).Value = txtPhotoPath.Value ' Save photo path

    ' Add comment with image to the cell
    With .Cells(lastRow, 12)
        .ClearComments
        .AddComment
        .Comment.Shape.Fill.UserPicture txtPhotoPath.Value
        .Comment.Shape.Width = Application.InchesToPoints(1.15)
        .Comment.Shape.Height = Application.InchesToPoints(1.35)
        .Comment.Visible = False
    End With
End If

End With

MsgBox "Data successfully saved!", vbInformation

' Clear the form
Call ClearForm
End Sub

Private Sub ClearForm()
txtSrNo.Value = ""
txtDate.Value = ""
txtTime.Value = ""
txtName.Value = ""
txtFatherName.Value = ""
txtMobile.Value = ""
comboCourse.Value = ""
optMale.Value = True
txtOfferFees.Value = ""
txtPaidFees.Value = ""
txtDueFees.Value = ""
imgPhoto.Picture = Nothing ' Clear the image
txtPhotoPath.Value = "" ' Clear the temporary photo path
End Sub

Private Sub cmdUploadPhoto_Click()
' Open FileDialog to upload photo
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "Select Photo"
fd.Filters.Clear
fd.Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.bmp"

If fd.Show = -1 Then
    ' Ensure a file was selected
    If Len(fd.SelectedItems(1)) > 0 Then
        ' Validate if the file exists
        If Dir(fd.SelectedItems(1)) <> "" Then
            On Error Resume Next

            ' Load the image in imgPhoto control (optional)
            imgPhoto.Picture = LoadPicture(fd.SelectedItems(1))

            If Err.Number <> 0 Then
                MsgBox "Error loading image. Please select a valid image file.", vbCritical
                Err.Clear
            Else
                ' Store the selected image path temporarily
                txtPhotoPath.Value = fd.SelectedItems(1) ' Store in a hidden textbox for later use

                MsgBox "Photo uploaded successfully!", vbInformation
            End If

            On Error GoTo 0
        Else
            MsgBox "Selected file does not exist or is not a valid image.", vbExclamation
        End If
    Else
        MsgBox "No image file selected.", vbExclamation
    End If
End If

End Sub

Private Sub imgPhoto_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Show photo path in the label when hovering over the image box
If Not imgPhoto.Picture Is Nothing Then
Dim photoPath As String
photoPath = ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row, 12).Value

' Set the label text to display the photo path
    lblPhotoPath.Caption = "Uploaded Photo Path: " & photoPath

    ' Make the label visible when hovering over the image
    lblPhotoPath.Visible = True
End If
End Sub

Private Sub imgPhoto_MouseLeave()
'Hide the label when mouse leaves the image area
lblPhotoPath.Visible = False
End Sub

Private Sub cmdSearch_Click()
Dim ws As Worksheet
Dim searchName As String
Dim foundCell As Range

'Set the worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")

' Get the name to search from txtSearch
searchName = txtSearch.Value

' Check if searchName is empty
If searchName = "" Then
    MsgBox "Please enter a name to search.", vbExclamation
    Exit Sub
End If

' Search for the name in column D (assuming names are in column 4)
Set foundCell = ws.Columns(4).Find(What:=searchName, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not foundCell Is Nothing Then
    ' Load data into the UserForm
    Dim rowNum As Long
    rowNum = foundCell.Row

    txtSrNo.Value = ws.Cells(rowNum, 1).Value
    txtDate.Value = ws.Cells(rowNum, 2).Value
    txtTime.Value = ws.Cells(rowNum, 3).Value
    txtName.Value = ws.Cells(rowNum, 4).Value
    txtFatherName.Value = ws.Cells(rowNum, 5).Value
    txtMobile.Value = ws.Cells(rowNum, 6).Value
    comboCourse.Value = ws.Cells(rowNum, 7).Value
    If ws.Cells(rowNum, 8).Value = "Male" Then
        optMale.Value = True
    Else
        optFemale.Value = True
    End If
    txtOfferFees.Value = ws.Cells(rowNum, 9).Value
    txtPaidFees.Value = ws.Cells(rowNum, 10).Value
    txtDueFees.Value = ws.Cells(rowNum, 11).Value
    txtPhotoPath.Value = ws.Cells(rowNum, 12).Value

    ' Load the photo into imgPhoto
    If txtPhotoPath.Value <> "" And Dir(txtPhotoPath.Value) <> "" Then
        imgPhoto.Picture = LoadPicture(txtPhotoPath.Value)
    Else
        imgPhoto.Picture = LoadPicture("") ' Clear image if path is invalid
    End If

    MsgBox "Data loaded successfully!", vbInformation
Else
    MsgBox "Name not found in the sheet.", vbExclamation
End If

End Sub

Private Sub cmdUpdate_Click()
Dim ws As Worksheet
Dim searchSrNo As String
Dim foundCell As Range
Dim currentUser As String

'Retrieve logged-in username from UserForm1
currentUser = UserForm1.txtUsername.Value

' Set the worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")

' Get the SR No to search
searchSrNo = txtSrNo.Value

' Check if SR No is empty
If searchSrNo = "" Then
    MsgBox "No record is loaded to update.", vbExclamation
    Exit Sub
End If

' Search for the SR No in column A (assuming SR No is in column 1)
Set foundCell = ws.Columns(1).Find(What:=searchSrNo, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not foundCell Is Nothing Then
    ' Update the data in the matched row
    Dim rowNum As Long
    rowNum = foundCell.Row

    ws.Cells(rowNum, 2).Value = txtDate.Value
    ws.Cells(rowNum, 3).Value = txtTime.Value
    ws.Cells(rowNum, 4).Value = txtName.Value
    ws.Cells(rowNum, 5).Value = txtFatherName.Value
    ws.Cells(rowNum, 6).Value = txtMobile.Value
    ws.Cells(rowNum, 7).Value = comboCourse.Value
    ws.Cells(rowNum, 8).Value = IIf(optMale.Value, "Male", "Female")
    ws.Cells(rowNum, 9).Value = txtOfferFees.Value
    ws.Cells(rowNum, 10).Value = txtPaidFees.Value
    ws.Cells(rowNum, 11).Value = txtDueFees.Value
    ws.Cells(rowNum, 12).Value = txtPhotoPath.Value

    ' Update Last Update Role (logged-in user)
    ws.Cells(rowNum, 14).Value = currentUser ' Column N: Last Update Role

    ' Update current timestamp
    ws.Cells(rowNum, 15).Value = Date ' Column O: Update Date
    ws.Cells(rowNum, 16).Value = Time ' Column P: Update Time

    MsgBox "Data updated successfully!", vbInformation
Else
    MsgBox "Record not found in the sheet.", vbExclamation
End If
End Sub

Private Sub cmdPrint_Click()
On Error GoTo ErrorHandler

' Ensure Sheet2 exists and is activated
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet2")
ws.Activate

' Transfer data to the print range
With ws
    .Range("B7").Value = txtSrNo.Value             ' SR No
    .Range("D7").Value = txtDate.Value            ' Date
    .Range("E7").Value = txtTime.Value            ' Time
    .Range("C8").Value = txtName.Value            ' Name
    .Range("C9").Value = txtFatherName.Value      ' Father Name
    .Range("C10").Value = txtMobile.Value         ' Mobile Number
    .Range("C12").Value = comboCourse.Value       ' Course
    .Range("C13").Value = IIf(optMale.Value, "Male", "Female") ' Gender
    .Range("C14").Value = txtCourseFees.Value     ' Course Fees
    .Range("C16").Value = txtOfferFees.Value      ' Offer Fees
    .Range("C17").Value = txtPaidFees.Value       ' Paid Fees
    .Range("C18").Value = txtDueFees.Value        ' Due Fees
End With

' Insert the photo into the specified shape (Rectangle1)
Dim imgPath As String
imgPath = txtPhotoPath.Value ' The path of the uploaded photo

If imgPath <> "" Then
    Dim photoShape As Shape
    Set photoShape = ws.Shapes("Rectangle1") ' Ensure the shape is named "Rectangle1"

    ' Delete any existing picture in the shape
    On Error Resume Next
    ws.Pictures(imgPath).Delete
    On Error GoTo ErrorHandler

    ' Load the picture into the shape
    photoShape.Fill.UserPicture (imgPath)
End If

' Inform the user
MsgBox "Data successfully transferred to Sheet2 for printing!", vbInformation

Exit Sub

ErrorHandler:
MsgBox "An error occurred: " & Err.Description, vbExclamation
End Sub
Private Sub UserForm_Terminate()
Call PerformLogout
End Sub

Private Sub PerformLogout()
Dim logSheet As Worksheet
Dim logoutRow As Long
Dim logoutTime As Double

' Reference the log sheet
Set logSheet = ThisWorkbook.Sheets("Sheet4")
logoutRow = CLng(UserForm1.Tag) ' Retrieve the row number from UserForm1.Tag

If logoutRow > 0 Then
    ' Update logout details
    With logSheet
        .Cells(logoutRow, 6).Value = Date ' Logout Date
        .Cells(logoutRow, 7).Value = Time ' Logout Time

        ' Calculate duration
        logoutTime = DateDiff("n", _
            .Cells(logoutRow, 2).Value + .Cells(logoutRow, 3).Value, _
            .Cells(logoutRow, 6).Value + .Cells(logoutRow, 7).Value)
        .Cells(logoutRow, 5).Value = logoutTime & " minutes" ' Update duration
    End With
End If

End Sub
'End of Userform2 Code

Yah ThisWorkbook ka Code Hai

'Yah ThisWorkbook Ka code Hai
Private Sub Workbook_Open()
    ' Hide Sheet3 and Sheet4 by default
    ThisWorkbook.Sheets("Sheet3").Visible = xlSheetVeryHidden
    ThisWorkbook.Sheets("Sheet4").Visible = xlSheetVeryHidden

    ' Hide Excel and show UserForm1
    Application.Visible = False
    UserForm1.Show
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim logSheet As Worksheet
    Dim lastRow As Long
    Dim logoutRow As Long
    Dim logoutTime As Double

    ' Reference the log sheet (Sheet4)
    Set logSheet = ThisWorkbook.Sheets("Sheet4")
    lastRow = logSheet.Cells(logSheet.Rows.Count, 1).End(xlUp).Row

    ' Find the last logged-in row (In Progress)
    For logoutRow = lastRow To 2 Step -1
        If logSheet.Cells(logoutRow, 5).Value = "In Progress" Then
            ' Update logout details
            logSheet.Cells(logoutRow, 6).Value = Date ' Logout Date
            logSheet.Cells(logoutRow, 7).Value = Time ' Logout Time

            ' Calculate duration
            logoutTime = DateDiff("n", _
                logSheet.Cells(logoutRow, 2).Value + logSheet.Cells(logoutRow, 3).Value, _
                logSheet.Cells(logoutRow, 6).Value + logSheet.Cells(logoutRow, 7).Value)
            logSheet.Cells(logoutRow, 5).Value = logoutTime & " minutes" ' Update duration
            Exit For
        End If
    Next logoutRow

    ' Ensure changes are saved
    ThisWorkbook.Save
End Sub
'End of ThisWorkbook Code

Watch This Video To Create Excel VBA Data Entry Projects by Pradip VedantSri