Data Entry Form with Validation

' Data Entry Form with Validation
' Creates a UserForm for structured data entry with comprehensive validation
' Target sheet columns: ID (A), Date (B), Name (C), Category (D),
'   Amount (E), Status (F), Notes (G)

Sub ShowDataEntryForm()
    ' Display the data entry form
    ' Note: This code creates the form programmatically
    ' In production, you would design the UserForm in the VBA editor
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' Ensure headers exist
    If ws.Cells(1, 1).Value = "" Then
        ws.Cells(1, 1).Value = "ID"
        ws.Cells(1, 2).Value = "Date"
        ws.Cells(1, 3).Value = "Name"
        ws.Cells(1, 4).Value = "Category"
        ws.Cells(1, 5).Value = "Amount"
        ws.Cells(1, 6).Value = "Status"
        ws.Cells(1, 7).Value = "Notes"

        With ws.Range("A1:G1")
            .Font.Bold = True
            .Interior.Color = RGB(0, 102, 204)
            .Font.Color = RGB(255, 255, 255)
        End With
    End If

    ' Use InputBox-based form (works without UserForm designer)
    Call CollectAndValidateEntry

    Exit Sub

ErrorHandler:
    MsgBox "Error showing form: " & Err.Description, vbCritical
End Sub

Sub CollectAndValidateEntry()
    ' Collect data with step-by-step validation
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' Generate next ID
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim nextID As Long
    If lastRow > 1 Then
        nextID = Val(ws.Cells(lastRow, 1).Value) + 1
    Else
        nextID = 1
    End If

    ' Collect date with validation
    Dim entryDate As String
    Dim isValidDate As Boolean
    Do
        entryDate = InputBox("Enter date (dd/mm/yyyy):" & vbCrLf & _
                            "(Leave blank for today)", "Date Entry", Format(Date, "dd/mm/yyyy"))
        If entryDate = "" Then
            entryDate = Format(Date, "dd/mm/yyyy")
            isValidDate = True
        Else
            ' Validate date format
            On Error Resume Next
            Dim testDate As Date
            testDate = CDate(entryDate)
            If Err.Number = 0 Then
                isValidDate = True
                ' Check date is not in the future
                If testDate > Date + 1 Then
                    MsgBox "Date cannot be in the future.", vbExclamation
                    isValidDate = False
                End If
            Else
                MsgBox "Invalid date format. Please use dd/mm/yyyy.", vbExclamation
                isValidDate = False
            End If
            On Error GoTo ErrorHandler
        End If
    Loop Until isValidDate

    ' Collect name with validation
    Dim entryName As String
    Do
        entryName = InputBox("Enter name:" & vbCrLf & _
                            "(Minimum 2 characters)", "Name Entry")
        If entryName = "" Then
            If MsgBox("Cancel data entry?", vbYesNo + vbQuestion) = vbYes Then Exit Sub
        ElseIf Len(Trim(entryName)) < 2 Then
            MsgBox "Name must be at least 2 characters.", vbExclamation
        Else
            entryName = Trim(entryName)
            Exit Do
        End If
    Loop

    ' Collect category from list
    Dim categories As String
    categories = "Sales" & vbCrLf & "Marketing" & vbCrLf & "Operations" & vbCrLf & _
                "Finance" & vbCrLf & "IT" & vbCrLf & "HR" & vbCrLf & "Other"

    Dim entryCategory As String
    Do
        entryCategory = InputBox("Select category (type number):" & vbCrLf & vbCrLf & _
                                "1. Sales" & vbCrLf & _
                                "2. Marketing" & vbCrLf & _
                                "3. Operations" & vbCrLf & _
                                "4. Finance" & vbCrLf & _
                                "5. IT" & vbCrLf & _
                                "6. HR" & vbCrLf & _
                                "7. Other", "Category")
        If entryCategory = "" Then
            If MsgBox("Cancel data entry?", vbYesNo + vbQuestion) = vbYes Then Exit Sub
        Else
            Select Case Val(entryCategory)
                Case 1: entryCategory = "Sales"
                Case 2: entryCategory = "Marketing"
                Case 3: entryCategory = "Operations"
                Case 4: entryCategory = "Finance"
                Case 5: entryCategory = "IT"
                Case 6: entryCategory = "HR"
                Case 7: entryCategory = "Other"
                Case Else
                    MsgBox "Please enter a number between 1 and 7.", vbExclamation
                    entryCategory = ""
            End Select
        End If
    Loop Until entryCategory <> ""

    ' Collect amount with validation
    Dim entryAmount As String
    Dim amount As Double
    Do
        entryAmount = InputBox("Enter amount:" & vbCrLf & _
                              "(Numeric value, e.g. 1500.50)", "Amount Entry")
        If entryAmount = "" Then
            If MsgBox("Cancel data entry?", vbYesNo + vbQuestion) = vbYes Then Exit Sub
        ElseIf Not IsNumeric(entryAmount) Then
            MsgBox "Please enter a valid number.", vbExclamation
        ElseIf Val(entryAmount) < 0 Then
            MsgBox "Amount cannot be negative.", vbExclamation
        Else
            amount = Val(entryAmount)
            Exit Do
        End If
    Loop

    ' Collect status
    Dim entryStatus As String
    Do
        entryStatus = InputBox("Select status (type number):" & vbCrLf & vbCrLf & _
                              "1. Pending" & vbCrLf & _
                              "2. Approved" & vbCrLf & _
                              "3. Rejected" & vbCrLf & _
                              "4. Completed", "Status")
        Select Case Val(entryStatus)
            Case 1: entryStatus = "Pending"
            Case 2: entryStatus = "Approved"
            Case 3: entryStatus = "Rejected"
            Case 4: entryStatus = "Completed"
            Case Else
                MsgBox "Please enter a number between 1 and 4.", vbExclamation
                entryStatus = ""
        End Select
    Loop Until entryStatus <> ""

    ' Collect notes (optional)
    Dim entryNotes As String
    entryNotes = InputBox("Enter notes (optional):", "Notes")

    ' Confirm entry
    Dim confirmMsg As String
    confirmMsg = "Please confirm the following entry:" & vbCrLf & vbCrLf & _
                "ID: " & nextID & vbCrLf & _
                "Date: " & entryDate & vbCrLf & _
                "Name: " & entryName & vbCrLf & _
                "Category: " & entryCategory & vbCrLf & _
                "Amount: " & Format(amount, "#,##0.00") & vbCrLf & _
                "Status: " & entryStatus & vbCrLf & _
                "Notes: " & entryNotes

    If MsgBox(confirmMsg, vbYesNo + vbQuestion, "Confirm Entry") = vbNo Then
        MsgBox "Entry cancelled.", vbInformation
        Exit Sub
    End If

    ' Write to sheet
    Dim newRow As Long
    newRow = lastRow + 1

    ws.Cells(newRow, 1).Value = nextID
    ws.Cells(newRow, 2).Value = entryDate
    ws.Cells(newRow, 3).Value = entryName
    ws.Cells(newRow, 4).Value = entryCategory
    ws.Cells(newRow, 5).Value = amount
    ws.Cells(newRow, 5).NumberFormat = "#,##0.00"
    ws.Cells(newRow, 6).Value = entryStatus
    ws.Cells(newRow, 7).Value = entryNotes

    ' Colour code status
    Select Case entryStatus
        Case "Pending"
            ws.Cells(newRow, 6).Interior.Color = RGB(255, 255, 200)
        Case "Approved"
            ws.Cells(newRow, 6).Interior.Color = RGB(200, 240, 200)
        Case "Rejected"
            ws.Cells(newRow, 6).Interior.Color = RGB(255, 200, 200)
        Case "Completed"
            ws.Cells(newRow, 6).Interior.Color = RGB(200, 230, 255)
    End Select

    ws.Columns("A:G").AutoFit

    MsgBox "Entry #" & nextID & " saved successfully!", vbInformation

    ' Ask to add another
    If MsgBox("Add another entry?", vbYesNo + vbQuestion) = vbYes Then
        Call CollectAndValidateEntry
    End If

    Exit Sub

ErrorHandler:
    MsgBox "Error during data entry: " & Err.Description, vbCritical
End Sub

Sub ValidateAllEntries()
    ' Scan existing data for validation issues
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    If lastRow < 2 Then
        MsgBox "No data to validate.", vbInformation
        Exit Sub
    End If

    Dim issues As String
    Dim issueCount As Long

    Dim i As Long
    For i = 2 To lastRow
        ' Check for missing required fields
        If ws.Cells(i, 2).Value = "" Then
            issues = issues & "Row " & i & ": Missing date" & vbCrLf
            issueCount = issueCount + 1
        End If

        If ws.Cells(i, 3).Value = "" Then
            issues = issues & "Row " & i & ": Missing name" & vbCrLf
            issueCount = issueCount + 1
        End If

        If ws.Cells(i, 4).Value = "" Then
            issues = issues & "Row " & i & ": Missing category" & vbCrLf
            issueCount = issueCount + 1
        End If

        ' Check for negative amounts
        If Val(ws.Cells(i, 5).Value) < 0 Then
            issues = issues & "Row " & i & ": Negative amount" & vbCrLf
            issueCount = issueCount + 1
            ws.Cells(i, 5).Interior.Color = RGB(255, 200, 200)
        End If

        ' Check for duplicate IDs
        Dim j As Long
        For j = i + 1 To lastRow
            If ws.Cells(i, 1).Value = ws.Cells(j, 1).Value And ws.Cells(i, 1).Value <> "" Then
                issues = issues & "Rows " & i & " and " & j & ": Duplicate ID " & ws.Cells(i, 1).Value & vbCrLf
                issueCount = issueCount + 1
                ws.Cells(j, 1).Interior.Color = RGB(255, 200, 200)
            End If
        Next j
    Next i

    If issueCount = 0 Then
        MsgBox "All " & (lastRow - 1) & " entries validated. No issues found.", vbInformation
    Else
        MsgBox "Found " & issueCount & " issue(s):" & vbCrLf & vbCrLf & issues, vbExclamation, "Validation Results"
    End If

    Exit Sub

ErrorHandler:
    MsgBox "Error validating data: " & Err.Description, vbCritical
End Sub