Prevent data entry in cell if data already exist in workbook based on value of column A&B

Copper Contributor

We are using a spreadsheet to track employee time and absences.  The workbook contains 4 similar sheets with the employee's number and name in columns A & B, respectively.  Each sheet represents a different department under the same manager.  I'm looking for a VBA or Macro to prevent data being entered on the same day for the same employee, regardless of where they appear in the workbook.  Rows 1 through 25 contain formulas to track specific events for the day and should not be affected by the restriction, employee's info starts in A26/B26 on each sheet with the rows following (Columns C through ND) for entering time (number of hours) or specific lettering to designate reason for absence for each day throughout the year, but an employee's info can appear on more than one sheet as they can move between departments. They may also appear on different rows for each sheet (capturing different roles under the same work unit).  I would also like a pop-up to appear when triggering the VBA or Macro.

 

Example below of what the sheets look like.  Note, SH represents a stat holiday and should be ignored in the formulas, this would be the only exception.  For the example below, John Doe is working 8 hours on January 2 through 5.  Data should be restricted for John Doe for those days anywhere in the workbook unless the data is removed from the original entry, first.  However, data can be entered for January 1, 6 and 7.  'SA' is a code entered to indicate an employee off for a scheduled day and is counted in the formula at the top of the spreadsheet.

 

  1-Jan2-Jan3-Jan4-Jan5-Jan6-Jan7-Jan
 Total Labourers Off:0000011
Emp #Emp Name       
123456Doe, JohnSH8888  
123457Doe, Mary88   SASA
123458Smith, Bob88   88
123459Last, FirstSH8888  
4 Replies
The workbook contains 4 similar sheets with the employee's number and name in columns A & B,
regardless of where they appear in the workbook.


why not consolidate 4 sheets to one sheet?

@peiyezhu Mainly, it is a visual aid for each department, same as the final page that combines all the information for the manager.  The reason they are not all in one is also due to the total number of employees, the different departments they are working in (each department needs the same tracking information, which is the first 26 rows of the sheets).  The spreadsheet attached to this is just a small example for reference as I am not allowed to share the actual file outside of the company.

prevent data being entered on the same day for the same employee

If you save in one sheet like
e.g.
date name department,

you can use countif or unique restrict in database to achieve your goal.

@slandy20 

You are asking a spreadsheet to do the work of a database and application, but here goes.


If you are already using VBA code in your workbook, you should already be aware of the security risk involved.


You did not mention the approximate number of employees that may appear on any of these spreadsheets. I wrote VBA code that assumes a maximum of 250, resulting in a last possible row of employee data of 275. I've made that number adjustable from one place.


This technique does not prevent data entry to an inappropriate daily cell, but it does immediately react to an entry there, rejecting the entry, and notifying the user why.
2024-01-15 SL MsgBox.png


So each of the (four) worksheets that contain a timesheet will require a Worksheet_Change event handler. The code in each will be identical, including a call to one of two procedures in a standard module; most of the work is done there.

 

Worksheet_Change code:

    Dim rngRangeOfInterest  As Range
    Dim rngModifiedCells    As Range    '...with time data
    
    '----
    Set rngRangeOfInterest = Me.Range("C" & in2FIRST_ROW_OF_EMPEE_TIMES _
            & ":" & strLAST_COL_OF_EMPEE_TIMES & in2LAST_ROW_OF_EMPEE_TIMES)
    Set rngModifiedCells = Intersect(Target, rngRangeOfInterest)
    If rngModifiedCells Is Nothing Then
        GoTo NextChangesOfInterest
    End If
    Call RejectInappropriateTimeEntry(Me, rngModifiedCells)
NextChangesOfInterest:
    '   [If there are more types of changes to be handled - currently or
    '   in the future - include code for them here.]

 

Standard module code:

    '====   PROJECT-LEVEL CONSTANTS
    Public Const in2FIRST_ROW_OF_EMPEE_TIMES As Integer = 26
    Public Const in2LAST_ROW_OF_EMPEE_TIMES As Integer = 275
    Public Const strLAST_COL_OF_EMPEE_TIMES = "ND"


Public Function CheckWorksheetForEmpeeHrs(ByVal pstrWorksheetName As String _
        , ByVal pin4EmpeeID As Long, ByVal pstrCheckColumn As String _
        ) As String

    Dim strReturnValue      As String
    
    Dim wsComparisonSheet   As Worksheet
    Dim rngEmpeeIDCell  As Range
    Dim strCellAddress  As String
    Dim strRowNum       As String   '(don't need to convert to number)
    Dim strCellValue    As String
    Dim strEmpeeName    As String
    
    '----
    Set wsComparisonSheet = Sheets(pstrWorksheetName)
    With wsComparisonSheet
        Set rngEmpeeIDCell = .Range("A" _
                & in2FIRST_ROW_OF_EMPEE_TIMES & ":A" _
                & in2LAST_ROW_OF_EMPEE_TIMES).Find( _
                pin4EmpeeID)
        If rngEmpeeIDCell Is Nothing Then
            '...the employee is not present on this worksheet.
            strReturnValue = "OK"
            GoTo CheckWSForEmpeeHrs_Exit
        End If
        strCellAddress = rngEmpeeIDCell.Address(False, False)
        strRowNum = Mid$(strCellAddress, 2)
        strCellValue = .Range(pstrCheckColumn & strRowNum).Value & ""
        If strCellValue = "" Then
            strReturnValue = "OK"
            GoTo CheckWSForEmpeeHrs_Exit
        ElseIf StrComp(strCellValue, "SH", vbTextCompare) = 0 Then
            strReturnValue = "OK"
            GoTo CheckWSForEmpeeHrs_Exit
        Else
            strEmpeeName = .Range("B" & strRowNum).Value & ""
            strReturnValue = "A value is already present in sheet " _
                    & pstrWorksheetName & " for " & strEmpeeName _
                    & ": " & strCellValue
        End If
    End With
CheckWSForEmpeeHrs_Exit:
    CheckWorksheetForEmpeeHrs = strReturnValue
    Exit Function

End Function


Public Sub RejectInappropriateTimeEntry(ByVal pwsEditedSheet As Worksheet _
        , ByRef prngModifiedCells As Range _
        )

    Dim in2Milepost As Integer  'for debugging
    Dim rngModifiedCell As Range
    Dim strModCellAddress   As String
    Dim in4PosnOfDollarSign As Long
    Dim strModCellColumn    As String
    Dim strModCellRow       As String   '(don't need to convert it to number)
    Dim strNewValue     As String
    Dim rngEmpeeIDCellA As Range    '...in the edited sheet
    Dim in4EmpeeID      As Long
    Dim strResult   As String   'result of check for one cell
    
    '----
    On Error GoTo RejectIDE_ErrHndlr
    For Each rngModifiedCell In prngModifiedCells
        '  --   Grab the new value and check it for special values.
        in2Milepost = 100
        strNewValue = rngModifiedCell.Value & ""
        in2Milepost = 110
        If strNewValue = "" Then
            GoTo NextModifiedCell
        ElseIf StrComp(strNewValue, "SH", vbTextCompare) = 0 Then
            'Per business rules, this is OK.
            GoTo NextModifiedCell
            ' => Consistency checks are not included.
        End If
        '  --   Gather information from the modified cell's address.
        in2Milepost = 150
        strModCellAddress = rngModifiedCell.Address(True, False)
        in2Milepost = 160
        in4PosnOfDollarSign = InStr(2, strModCellAddress, "$")
        strModCellColumn = Left$(strModCellAddress, in4PosnOfDollarSign - 1)
        in2Milepost = 170
        strModCellRow = Mid$(strModCellAddress, in4PosnOfDollarSign + 1)
        '  --   Get the Employee ID for this row.
        in2Milepost = 190
        Set rngEmpeeIDCellA = pwsEditedSheet.Range("A" & strModCellRow)
        in4EmpeeID = rngEmpeeIDCellA.Value
        '  --   In very similar blocks of code, check the sheets for already-
        '       present data for that person & date among other departments.
        '       If such data found, "erase" the new data and issue a message.
        in2Milepost = 200
        If pwsEditedSheet.Name <> "Dept1" Then
            strResult = CheckWorksheetForEmpeeHrs("Dept1" _
                    , in4EmpeeID, strModCellColumn)
            If strResult <> "OK" Then
                Application.EnableEvents = False
                rngModifiedCell.Value = Empty
                Application.EnableEvents = True
                '
                Call MsgBox(strResult & vbCrLf & vbCrLf & "Your input was removed." _
                        , vbExclamation Or vbOKOnly _
                        , "Inappropriate Data Entry for Time")
                GoTo NextModifiedCell
            End If
        End If
        in2Milepost = 220
        If pwsEditedSheet.Name <> "Dept2" Then
            strResult = CheckWorksheetForEmpeeHrs("Dept2" _
                    , in4EmpeeID, strModCellColumn)
            If strResult <> "OK" Then
                Application.EnableEvents = False
                rngModifiedCell.Value = Empty
                Application.EnableEvents = True
                '
                Call MsgBox(strResult & vbCrLf & vbCrLf & "Your input was removed." _
                        , vbExclamation Or vbOKOnly _
                        , "Inappropriate Data Entry for Time")
                GoTo NextModifiedCell
            End If
        End If
        in2Milepost = 240
        If pwsEditedSheet.Name <> "Dept3" Then
            strResult = CheckWorksheetForEmpeeHrs("Dept3" _
                    , in4EmpeeID, strModCellColumn)
            If strResult <> "OK" Then
                Application.EnableEvents = False
                rngModifiedCell.Value = Empty
                Application.EnableEvents = True
                '
                Call MsgBox(strResult & vbCrLf & vbCrLf & "Your input was removed." _
                        , vbExclamation Or vbOKOnly _
                        , "Inappropriate Data Entry for Time")
                GoTo NextModifiedCell
            End If
        End If
        in2Milepost = 260
        If pwsEditedSheet.Name <> "Dept4" Then
            strResult = CheckWorksheetForEmpeeHrs("Dept4" _
                    , in4EmpeeID, strModCellColumn)
            If strResult <> "OK" Then
                Application.EnableEvents = False
                rngModifiedCell.Value = Empty
                Application.EnableEvents = True
                '
                Call MsgBox(strResult & vbCrLf & vbCrLf & "Your input was removed." _
                        , vbExclamation Or vbOKOnly _
                        , "Inappropriate Data Entry for Time")
                GoTo NextModifiedCell
            End If
        End If
NextModifiedCell:
    Next rngModifiedCell
    
RejectIDE_Exit:
    Exit Sub

RejectIDE_ErrHndlr:
    Dim in4ErrorCode    As Long
    Dim strErrorDescr   As String
    Dim strMessage      As String
    '  --   Capture data about the processing error.
    in4ErrorCode = Err.Number
    strErrorDescr = Err.Description
    '  --   Inform the user.
    strMessage = "Error " & in4ErrorCode & ":" & vbCrLf _
            & strErrorDescr & vbCrLf & vbCrLf & in2Milepost
    Call MsgBox(strMessage, vbExclamation Or vbOKOnly _
            , "RejectInappropriateTimeEntry")
    '  --
    If in2Milepost >= 200 Then
        Resume NextModifiedCell
    Else
        Resume RejectIDE_Exit
    End If
End Sub

Of course, you would use different worksheet name literals in procedure RejectInappropriateTimeEntry.


And the code can easily be defeated. I'll assume this is to catch unintentionally inappropriate entries.