How to add an Pop-up message

[krismcmillan]

Hi

I'm trying to create an holiday tracker spreadsheet. But I'm stuck as I need to create a pop-up box warning the Manager that he has got two people on a rest day. When he tries and allow a another person to have the same day off - in a Core area.

The core areas are:

FLT
Admin
Reciever
Operative
Despatch

I'm using Excel 2010

I have attached an example of the spreadsheet.


Thanks

Kris

[mancubus]

hi.

which action will trigger the warning?

[krismcmillan]

By input a RD (for Rest Day) or an 1 or 0.5 (holidays) and 1E or 0.5E (for emergency holidays)

[mancubus]

so they (RD, 1, 0.5, 1E, 0.5E) are all identical when raising a warning or only RDs count?

[krismcmillan]

What should happen, is the following

Fred is on a rest day
John is on the same rest day as Fred
Joe wants the same day off as Fred and John - a pop-up should appear to say that there are two people on a rest day in a specific area.

Fred is on holiday
John is also on holiday
Joe wants the same day off as Fred and John - a pop-up should appear to say that there are two people on holiday in a specific area.

Fred is on holiday
John is also on holiday
Joe wants the an (emergency) day off as Fred and John - a pop-up should appear to say that there are two people on holiday in a specific area.

[mancubus]

I am not available until friday. Members please feel free to reply the thread.

Btw, i understand, any entry under employee name is a holiday. What is important is whether the employee is in core area. I guess, at least...

[Paul_Hossler]

I'd probably start with something like this

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rEmployees As Range, rRow As Range
    Dim iCol As Long, iMaxCol As Long
    Dim iRest As Long, iHoliday As Long, iEmergency As Long
    Dim sMsg As String
    
    Set rEmployees = Me.Cells(1, 1).CurrentRegion
    
    iMaxCol = rEmployees.Columns.Count
    
    If Intersect(rEmployees, Target) Is Nothing Then Exit Sub
    
    Set rEmployees = Intersect(rEmployees, Target)
    
    For Each rRow In rEmployees.Rows
    
        With rRow.EntireRow
            iRest = 0
            iHoliday = 0
            iEmergency = 0
        
            For iCol = 2 To iMaxCol
                If .Cells(iCol).Value Like "RD" Then
                    iRest = iRest + 1
                ElseIf Right(.Cells(iCol).Value, 1) Like "E" Then
                    iEmergency = iEmergency + 1
                ElseIf .Cells(iCol).Value = 1 Or .Cells(iCol).Value = 0.5 Then
                    iHoliday = iHoliday + 1
                End If
            Next iCol
            
            If iRest > 1 Then
                sMsg = "Rest Days:" & vbCrLf & vbCrLf
                sMsg = sMsg & "    " & iRest & " Employees have Rest Days on the " & .Cells(1).Value
                Call MsgBox(sMsg, vbCritical + vbOKOnly, "Day Checker")
            End If
            If iHoliday > 1 Then
                sMsg = "Holidays:" & vbCrLf & vbCrLf
                sMsg = sMsg & "    " & iHoliday & " Employees have Holidays on the " & .Cells(1).Value
                Call MsgBox(sMsg, vbCritical + vbOKOnly, "Day Checker")
            End If
            If iEmergency > 1 Then
                sMsg = "Emergency Days:" & vbCrLf & vbCrLf
                sMsg = sMsg & "    " & iEmergency & " Employees have Emergency Days on the " & .Cells(1).Value
                Call MsgBox(sMsg, vbCritical + vbOKOnly, "Day Checker")
            End If
        End With
    Next
End Sub