Forum Discussion
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-Jan | 2-Jan | 3-Jan | 4-Jan | 5-Jan | 6-Jan | 7-Jan | ||
Total Labourers Off: | 0 | 0 | 0 | 0 | 0 | 1 | 1 | |
Emp # | Emp Name | |||||||
123456 | Doe, John | SH | 8 | 8 | 8 | 8 | ||
123457 | Doe, Mary | 8 | 8 | SA | SA | |||
123458 | Smith, Bob | 8 | 8 | 8 | 8 | |||
123459 | Last, First | SH | 8 | 8 | 8 | 8 |
- peiyezhuBronze ContributorThe 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?- slandy20Copper 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.
- peiyezhuBronze Contributorprevent 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.
- SnowMan55Bronze Contributor
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.