Forum Discussion

slandy20's avatar
slandy20
Copper Contributor
Jan 11, 2024

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

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  
  • peiyezhu's avatar
    peiyezhu
    Bronze Contributor
    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?
    • slandy20's avatar
      slandy20
      Copper Contributor

      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.

      • peiyezhu's avatar
        peiyezhu
        Bronze Contributor
        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.
  • SnowMan55's avatar
    SnowMan55
    Bronze Contributor

    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.


    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.

Resources