Hi All,
I am trying to make a workbook to automate holiday booking for employees, making it easier to book, cancel, approve, or decline holidays and keep track of holidays left to book. It automatically calculates holidays remaining from the employees annual entitlement, stops holidays been booked more than once and checks for clashes with existing holidays. It sends emails to the employee for all requests letting them know if the request has been approved, declined or cancelled. It also keeps a log of all holiday requests and emails sent.
The problem I am having is cancelling holidays doesn’t work properly.
The employee can cancel holidays that were never approved or have already been cancelled, which gives them extra holiday days they shouldn’t have. Also it doesn’t always check if a cancelled holiday was a full day or half day.
What I need help with is adding a check before cancelling a holiday, so that the user shouldn’t be able to cancel holidays that weren’t authorised. Holidays that were already cancelled can’t be cancelled again. A check if a half-day or full-day cancellation matches the original request. Ideally I would also like this to work for any holiday requests that span across several days and only cancel the days in the date range that has already been authorised. With a change in the log recording so this is easily visible for the end user.
Hopefully all the above makes sense and I have attached the current code I have.
I think the bit of code I have wrong is the following
Unfortunately the firewall on my work laptop will not allow me to download xl2bb to attach a copy of the workbook.
All help would be greatly appreciated.
I am trying to make a workbook to automate holiday booking for employees, making it easier to book, cancel, approve, or decline holidays and keep track of holidays left to book. It automatically calculates holidays remaining from the employees annual entitlement, stops holidays been booked more than once and checks for clashes with existing holidays. It sends emails to the employee for all requests letting them know if the request has been approved, declined or cancelled. It also keeps a log of all holiday requests and emails sent.
The problem I am having is cancelling holidays doesn’t work properly.
The employee can cancel holidays that were never approved or have already been cancelled, which gives them extra holiday days they shouldn’t have. Also it doesn’t always check if a cancelled holiday was a full day or half day.
What I need help with is adding a check before cancelling a holiday, so that the user shouldn’t be able to cancel holidays that weren’t authorised. Holidays that were already cancelled can’t be cancelled again. A check if a half-day or full-day cancellation matches the original request. Ideally I would also like this to work for any holiday requests that span across several days and only cancel the days in the date range that has already been authorised. With a change in the log recording so this is easily visible for the end user.
Hopefully all the above makes sense and I have attached the current code I have.
VBA Code:
Private Sub btnSubmit_Click()
Dim wsHolidays As Worksheet, wsEmployee As Worksheet, wsBankHolidays As Worksheet, wsEmailLog As Worksheet
Dim empName As String, properEmpName As String, holidayType As String, status As String
Dim startDate As Date, endDate As Date, startTime As String, endTime As String
Dim daysRequested As Double, daysBooked As Double, empRow As Range, foundHoliday As Range
Dim remainingHolidays As Double, totalHolidays As Double, emailBody As String, emailSubject As String
Dim emailTimestamp As String, senderName As String, d As Date, found As Range
Set wsHolidays = ThisWorkbook.Sheets("Holidays Booked")
Set wsEmployee = ThisWorkbook.Sheets("Employee Data")
Set wsBankHolidays = ThisWorkbook.Sheets("Bank Holidays")
Set wsEmailLog = ThisWorkbook.Sheets("Email Log")
empName = cboEmployee.Value
properEmpName = Application.WorksheetFunction.Proper(empName)
holidayType = cboHolidayType.Value
startDate = CDate(txtFirstDay.Value)
If holidayType = "Half Day Holiday" Or holidayType = "Cancel Half Day Holiday" Or holidayType = "Authorised Absence" Then
endDate = startDate
Else
endDate = CDate(txtLastDay.Value)
End If
status = cboStatus.Value
startTime = txtStartTime.Value
endTime = txtEndTime.Value
senderName = Environ("USERNAME")
' Work out the Number of Days booked
daysRequested = 0
For d = startDate To endDate
If Weekday(d, vbMonday) < 6 Then ' Monday-Friday only
Set found = wsBankHolidays.Range("A:A").Find(d, LookAt:=xlWhole)
If found Is Nothing Then daysRequested = daysRequested + 1
End If
Next d
If holidayType = "Half Day Holiday" Or holidayType = "Cancel Half Day Holiday" Then daysRequested = 0.5
daysBooked = daysRequested
If status = "Declined" Then
daysBooked = 0
End If
' Check for Holiday Cancellations
If holidayType = "Cancel Full Day Holiday" Or holidayType = "Cancel Half Day Holiday" Then
' Look for an authorised holiday already matching the employee, date, and type
Set foundHoliday = wsHolidays.Range("A:A").Find(properEmpName, LookAt:=xlWhole)
Do While Not foundHoliday Is Nothing
If foundHoliday.Offset(0, 1).Value = startDate And _
foundHoliday.Offset(0, 2).Value = endDate And _
foundHoliday.Offset(0, 4).Value = "Authorised" And _
foundHoliday.Offset(0, 5).Value = Replace(holidayType, "Cancel ", "") Then
Exit Do
End If
Set foundHoliday = wsHolidays.Range("A:A").FindNext(foundHoliday)
Loop
If foundHoliday Is Nothing Then
MsgBox "No holiday found that can be cancelled."
Exit Sub
End If
daysBooked = -daysRequested
End If
Set empRow = wsEmployee.Range("A:A").Find(empName, LookAt:=xlWhole)
If Not empRow Is Nothing Then
totalHolidays = empRow.Offset(0, 12).Value
If holidayType = "Cancel Full Day Holiday" Or holidayType = "Cancel Half Day Holiday" Then
empRow.Offset(0, 13).Value = empRow.Offset(0, 13).Value - daysRequested
ElseIf status <> "Declined" Then
empRow.Offset(0, 13).Value = empRow.Offset(0, 13).Value + daysBooked
End If
remainingHolidays = totalHolidays - empRow.Offset(0, 13).Value
empRow.Offset(0, 14).Value = remainingHolidays
End If
wsHolidays.Cells(wsHolidays.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 11).Value = _
Array(properEmpName, startDate, endDate, daysBooked, status, holidayType, startTime, endTime, "", "", remainingHolidays)
wsHolidays.Cells(wsHolidays.Rows.Count, 11).End(xlUp).Value = remainingHolidays
' Get email together
emailSubject = holidayType & " has been " & status
emailBody = "Dear " & Split(properEmpName, " ")(0) & "," & vbNewLine & vbNewLine
emailBody = emailBody & "Your " & holidayType & " for " & Format(startDate, "dd/mm/yyyy") & " to " & Format(endDate, "dd/mm/yyyy") & _
" for " & daysRequested & " days has been " & status & "." & vbNewLine & vbNewLine
emailBody = emailBody & "You still have " & remainingHolidays & " days entitlement left for " & Year(Date) & "."
Dim OutlookApp As Object, OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = empRow.Offset(0, 8).Value
.subject = emailSubject
.body = emailBody
.Display
End With
emailTimestamp = Format(Now, "dd/mm/yyyy HH:MM")
wsEmailLog.Cells(wsEmailLog.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 8).Value = _
Array(emailTimestamp, properEmpName, status, emailSubject, "Sent", startDate, endDate, senderName)
End SubI think the bit of code I have wrong is the following
VBA Code:
' Check for Holiday Cancellations
If holidayType = "Cancel Full Day Holiday" Or holidayType = "Cancel Half Day Holiday" Then
' Look for an authorised holiday already matching the employee, date, and type
Set foundHoliday = wsHolidays.Range("A:A").Find(properEmpName, LookAt:=xlWhole)
Do While Not foundHoliday Is Nothing
If foundHoliday.Offset(0, 1).Value = startDate And _
foundHoliday.Offset(0, 2).Value = endDate And _
foundHoliday.Offset(0, 4).Value = "Authorised" And _
foundHoliday.Offset(0, 5).Value = Replace(holidayType, "Cancel ", "") Then
Exit Do
End If
Set foundHoliday = wsHolidays.Range("A:A").FindNext(foundHoliday)
Loop
If foundHoliday Is Nothing Then
MsgBox "No holiday found that can be cancelled."
Exit SubUnfortunately the firewall on my work laptop will not allow me to download xl2bb to attach a copy of the workbook.
All help would be greatly appreciated.
