Clear Cell After Messagebox

I have a grid of cells that evaluate to "yes" (true) or "no" (false)

Upon entering a name in a particular range of cells, J7:J165, if a particular condition evaluates to true, I would like a message box to appear, warning of the error, and then clear the name out of the cell and keep the focus on it.

It would look something like:

a name gets picked from a drop down menu in cell J7

One of the conditions would be in cell J172. If it's "no", nothing happens, if it's true, then how I currently have it set up is that it calls a public function, for instance, availabilitycheck(),....the formula in cell J172 is:

=IF(OR(Schedule!B7<VLOOKUP(J7,EmpInfo!$C$3:$V$200,7,FALSE),((IF(F7="close",(MOD($AE$4-B7,1))*24,(MOD(F7-B7,1))*24))>=MOD(VLOOKUP(J7,EmpInfo!$C$3:$V$200,8,FALSE)-Schedule!B7,1)*24)),availability(),"no")

The function contains the message box, and it is here I would like to also be able to clear the contents of the selected cell.

I had a similar question not too long ago, and the solution was:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myrange As Range
    Set myrange = Range("J7:J165")
    If Not Intersect(Target, myrange) Is Nothing Then
        Application.EnableEvents = False
        If WorksheetFunction.CountIf(myrange, Target) > 1 Then
            MsgBox "This employee has already been scheduled during the Friday matinee shift.", vbExclamation + vbOKOnly, "Duplicate Shift"
            Target = ""
            Target.Activate
        End If
        GoTo exit_sub
    End If

Set myrange = Range("Z7:Z165")
    If Not Intersect(Target, myrange) Is Nothing Then
        Application.EnableEvents = False
        If WorksheetFunction.CountIf(myrange, Target) > 1 Then
            MsgBox "This employee has already been scheduled during the Friday evening shift.", vbExclamation + vbOKOnly, "Duplicate Shift"
            Target = ""
            Target.Activate
        End If
    End If
exit_sub:
    Application.EnableEvents = True
End Sub

I also experimented with this, not as a public function, obviously......

I tried substituting Vlookup in place of the worksheetfunction.countif, and taking out the function call in the excel vlookup formula and replacing with "yes" (as the vlookup formula would evaluate to "yes" or "no", but I could not get the vba code to work.

In the vb code, to locate the cell in question that would potentially throw up the messagebox, the vlookup expression would take the value in the cell that the name was dropped in, then check it against the range B172:Q330, the cell that contains the true/false value would be 9 columns over.....the range is greater than 9 columns because I would just use this a constant range, just change the # of columns where necessary.

I thought maybe the fact that the "cell" that the name gets dropped in was actually a collection of merged cells was the culprit, but the code I included here from a previous response works on the same range, and does exactly what I want to do in this situation.

I explain things horribly, so +rep if you even understand what I just wrote......

Please post a sample workbook so the code and data can be tested in context.

Regards

Apologies: I did look at the workbook. I can see how the current code works but, sadly, I don't really understand what you want to do differently.

I'll see if I can get someone else to have a look.

Regards

your current code seems to check the current column for duplicates. What is the purpose of the "yes" in the rows below?

1) Change the named range EmpList Refers To: formula to this:

=OFFSET(EmpInfo!$C$3,,,COUNTA(EmpInfo!$A:$A)-1,1)

2) Simplified some EmpInfo formulas

C3: =B3&", "&A3
E3: =DATEDIF(D3,TODAY(),"y")

Also, the ADD EMPLOYEE macro now adds these formulas properly including cleaned up phone numbers.

3) Schedule:

- drop down list will not show employees until you fill in a shift
- A6 is a drop down for jobs, used later to check the job certifications
- Not sure any of the stuff at the bottom is needed anymore
- This is the new sheet code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRANGE As Range, Cnt As Long, DayCol As Long, EmpRow As Long, JobCol As Long
Dim TimeOff As Range, CurDay As String, Job As String

    If Not Intersect(Target, Range("J7:J165, Z7:Z165")) Is Nothing And Target.Cells(1, 1).Value <> "" Then
        On Error Resume Next
        CurDay = Format([H1], "DDDD")
        Cnt = Application.WorksheetFunction.CountIf(Range(Cells(7, Target.Column), Cells(165, Target.Column)), Target)
        Application.EnableEvents = False
        If Cnt > 1 Then
            MsgBox "This employee has already been scheduled during this " & CurDay & " shift.", vbExclamation + vbOKOnly, "Duplicate Shift"
            Target = ""
            Target.Activate
            GoTo Finished
        End If
        
    'check timeoff requests
        DayCol = Sheets("TimeOff").Rows(3).Find(CurDay, LookIn:=xlValues, LookAt:=xlWhole).Column
        Set TimeOff = Sheets("TimeOff").Columns(DayCol).Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
        If Not TimeOff Is Nothing Then
            MsgBox "This employee has requested this time off for " & CurDay & ".", vbExclamation + vbOKOnly, "Time Off"
            Target = ""
            Target.Activate
            GoTo Finished
        End If
        
    'check availability
        With Sheets("EmpInfo")
            DayCol = .Rows(1).Find(CurDay, LookIn:=xlValues, LookAt:=xlWhole).Column
            EmpRow = .Range("C:C").Find(Target, LookIn:=xlValues, LookAt:=xlWhole).Row
            If Round(.Cells(EmpRow, DayCol), 6) > Round(Target.Offset(, -8).Value, 6) Or _
                  Round(.Cells(EmpRow, DayCol + 1), 6) < Round(Target.Offset(, -4).Value, 6) Then
                MsgBox Target & " availability for " & CurDay & " is:" & vbLf & vbLf & _
                    " Start: " & Format(.Cells(EmpRow, DayCol), "HH:MM AM/PM") & vbLf & _
                    "  End: " & Format(.Cells(EmpRow, DayCol + 1), "HH:MM AM/PM"), vbExclamation + vbOKOnly, "Not Available"
                Target = ""
                Target.Activate
                GoTo Finished
            End If
        
    'check job
            JobCol = .Rows(1).Find([A6], LookIn:=xlValues, LookAt:=xlWhole).Column
            If Not .Cells(EmpRow, JobCol) Then
                If MsgBox("This employee is not certified for this position." & vbLf & _
                    "Schedule them anyway?", vbExclamation + vbYesNo, "Time Off") = vbNo Then
                    Target = ""
                    Target.Activate
                    GoTo Finished
                End If
            End If
        End With
    
        
    
    End If
    
Finished:
    Application.EnableEvents = True
End Sub

4)

If the conditions are more jobs, just add them as shown and the existing code will check for those jobs, too.

If it's new kinds of conditions, the samples I gave for checking TimeOFF, Availability and Job Certifications by job name should provide a basis for developing new tests.

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.

We're all about teaching! Hehe, streeeeeeeeeetch....

Here's the code again with more guidelines about what each line does, let's look through the code and find what isn't logical to you yet. Use F8 to activate the macro and step through the code one line at a time, after each code executes, hover your mouse over the variables to see the results, and check the sheets to see how it got those answers.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRANGE As Range, Cnt As Long, DayCol As Long, EmpRow As Long, JobCol As Long
Dim TimeOff As Range, CurDay As String, Job As String

'Make sure the changed cell requires analysis
    If Not Intersect(Target, Range("J7:J165, Z7:Z165")) Is Nothing And Target.Cells(1, 1).Value <> "" Then
        On Error Resume Next
      'store the name of today so we can look it up later
        CurDay = Format([H1], "DDDD")
      'count how many times this name appears in the current column
        Cnt = Application.WorksheetFunction.CountIf(Range(Cells(7, Target.Column), Cells(165, Target.Column)), Target)
        Application.EnableEvents = False
        If Cnt > 1 Then     'if the name appears more than once, remove it
            MsgBox "This employee has already been scheduled during this " & CurDay & " shift.", vbExclamation + vbOKOnly, "Duplicate Shift"
            Target = ""
            Target.Activate
            GoTo Finished
        End If
        
    'check timeoff requests
      'Find the day being scheduled in the TimeOff sheet, which column needs to be checked
        DayCol = Sheets("TimeOff").Rows(3).Find(CurDay, LookIn:=xlValues, LookAt:=xlWhole).Column
      'Try to find the current name entered in the correct column of TimeOff sheet
        Set TimeOff = Sheets("TimeOff").Columns(DayCol).Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
      'if the name WAS found, do not allow to be scheduled
        If Not TimeOff Is Nothing Then
            MsgBox "This employee has requested this time off for " & CurDay & ".", vbExclamation + vbOKOnly, "Time Off"
            Target = ""
            Target.Activate
            GoTo Finished
        End If
        
    'Check the employee info sheet availability column for this day
        With Sheets("EmpInfo")
          'Find the correct column for this day
            DayCol = .Rows(1).Find(CurDay, LookIn:=xlValues, LookAt:=xlWhole).Column
          'find the correct row for this employee
            EmpRow = .Range("C:C").Find(Target, LookIn:=xlValues, LookAt:=xlWhole).Row
          'check if the begin time is too early, or the end time too late
            If Round(.Cells(EmpRow, DayCol), 6) > Round(Target.Offset(, -8).Value, 6) Or _
                  Round(.Cells(EmpRow, DayCol + 1), 6) < Round(Target.Offset(, -4).Value, 6) Then
          'if it's outside available times, disallow the shift
                MsgBox Target & " availability for " & CurDay & " is:" & vbLf & vbLf & _
                    " Start: " & Format(.Cells(EmpRow, DayCol), "HH:MM AM/PM") & vbLf & _
                    "  End: " & Format(.Cells(EmpRow, DayCol + 1), "HH:MM AM/PM"), vbExclamation + vbOKOnly, "Not Available"
                Target = ""
                Target.Activate
                GoTo Finished
            End If
        
    'check job function against the employees certified jobs, must list as TRUE to allow
          'find the column for the  current job being scheduled
            JobCol = .Rows(1).Find([A6], LookIn:=xlValues, LookAt:=xlWhole).Column
          'if the employees row does not say TRUE in that column, warning message
            If Not .Cells(EmpRow, JobCol) Then
              'message will allow them to override the certification and schedule it anyway
                If MsgBox("This employee is not certified for this position." & vbLf & _
                    "Schedule them anyway?", vbExclamation + vbYesNo, "Time Off") = vbNo Then
                    Target = ""
                    Target.Activate
                    GoTo Finished
                End If
            End If
        End With
    End If
    
Finished:
    Application.EnableEvents = True
End Sub

Meanwhile, a simple way to check if a cell cell "yes" in a specific distance away/below:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("J7:J165, Z7:Z165")) Is Nothing And Target.Cells(1, 1).Value <> "" Then
        If Target.Cells(1, 1).Offset(165) = "yes" Then
            Application.EnableEvents = False
            Application.Undo
            Target.Select
            Application.EnableEvents = True
        End If
    End If

End Sub