I am currently using the below code for a holiday request form it takes the values on sheet 1:
Employee Name : B7 Employee Number : B9 Team : B11
matches them against a reference on their team holiday sheet (determined on sheet1 B11) To Book Holiday in on dates determined in :
Sheet 1 From(b21) To(C21) Half Or Full Day (D21)
What I am having trouble with is the booking of the holidays as at most I can only have 2 people off at a time but it is letting more than that and is also letting them exceed their allotted holiday which is determined in the request form (25days Sheet 1 B12)
would anyone know to put in a statement so if there is already 2 people off it would reply with a error message and the same for if they exceeded their holiday limit ( Sheet1 B12)
There is an old code that I was using previously but have tried running individual parts of it but to no avail
any questions I am more than happy to answer
many thanks
jamie
Code That I am Currently Using
Sub NewBookingCheck()
Dim Name As String, Team As String, StartRng As String, EndRng As String, ShiftRng As String, Final As String
Dim LastRow As Long
Dim Rng As Range, Rng2 As Range, cRange As Range, Cell As Range
Team = Sheets(“Sheet1”).Range("B11").Value
Name = Team & Replace(Sheets(“Sheet1”).Range("B7").Value, " ", "")
LastRow = Sheets(Team).Cells(Rows.Count, "A").End(xlUp).Row
If Sheets(“Sheet1”).Range("B21").Value = Sheets(“Sheet1”).Range("C21").Value Then
StartRng = Left(Sheets(“Sheet1”).Range("B21").Value, 2) & Mid(Sheets(“Sheet1”).Range("B21").Value, 4, 2) & Right(Sheets(“Sheet1”).Range("B21").Value, 2)
If Sheets(“Sheet1”).Range("D21").Value <> "" Then
ShiftRng = Sheets(“Sheet1”).Range("D21").Value
Else
ShiftRng = "Full"
End If
Final = Team & StartRng & ShiftRng
Set Rng = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final))
If Application.WorksheetFunction.CountA(Sheets(Team).Range(Sheets(Team).Cells(3, Rng.Column), Sheets(Team).Cells(LastRow, Rng.Column))) < 2 Then
Rng.Interior.ColorIndex = 6
Rng.Value = "BOOKED"
Rng.Font.Bold = True
End If
Else
StartRng = Left(Sheets(“Sheet1”).Range("B21").Value, 2) & Mid(Sheets(“Sheet1”).Range("B21").Value, 4, 2) & Right(Sheets(“Sheet1”).Range("B21").Value, 2)
EndRng = Left(Sheets(“Sheet1”).Range("C21").Value, 2) & Mid(Sheets(“Sheet1”).Range("C21").Value, 4, 2) & Right(Sheets(“Sheet1”).Range("C21").Value, 2)
ShiftRng = "Full"
Final = Team & StartRng & ShiftRng
Set Rng = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final))
Final = Team & EndRng & ShiftRng
Set Rng2 = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final))
Set cRange = Sheets(Team).Range(Rng, Rng2)
For Each Cell In cRange
If Application.WorksheetFunction.CountA(Sheets(Team).Range(Sheets(Team).Cells(3, Cell.Column), Sheets(Team).Cells(LastRow, Cell.Column))) < 2 Then
Cell.Interior.ColorIndex = 6
Cell.Value = "BOOKED"
Cell.Font.Bold = True
End If
Next Cell
End If
MsgBox "Complete"
Run "HaveYouFinished"
End Sub
Old Code Which has working IF Statement
Sub RequestHoliday()
Dim Cell As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range
Dim dRange As Range, nRange As Range, oRange As Range
Dim FindStart As Date, FindEnd As Date, FindName As String, Department As String
Dim HolRemaining As Integer, HolRequested As Integer
Dim LastCol As Long, LastRow As Long, LastRowHidden As Long
If Sheets("Request Form").Range("B7").Value = "" Then
MsgBox "Please enter the member of staff booking holiday", vbOKOnly, "Name Required"
Exit Sub
ElseIf Sheets("Request Form").Range("B21").Value = "" Then
MsgBox "Please enter a valid start date", vbOKOnly, "Start Date Required"
Exit Sub
ElseIf Sheets("Request Form").Range("C21").Value = "" Then
MsgBox "Please enter a valid end date", vbOKOnly, "End Date Required"
Exit Sub
End If
FindName = Sheets("Request Form").Range("B7").Value
FindStart = Sheets("Request Form").Range("B21").Value
FindEnd = Sheets("Request Form").Range("C21").Value
FindShift = Sheets("Request Form").Range("B12").Value
Department = Sheets("Request Form").Range("B11").Value
LastCol = Sheets(Department).Cells(3, Columns.Count).End(xlToLeft).Column
LastRow = Sheets(Department).Cells(Rows.Count, "A").End(xlUp).Row
Set dRange = Sheets(Department).Range("B1", Sheets(Department).Cells(1, LastCol))
Set nRange = Sheets(Department).Range("A3:A" & LastRow)
*If FindStart <> FindEnd Then
With dRange
Set Rng1 = .Find(What:=FindStart, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng1 Is Nothing Then
Set Rng2 = .Find(What:=FindEnd, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng2 Is Nothing Then
Set oRange = Sheets(Department).Range(Rng1, Rng2)
For Each Cell In oRange
If Application.WorksheetFunction.CountA(Range(Sheets(Department).Cells(3, Cell.Column), Sheets(Department).Cells(LastRow, Cell.Column))) > 1 Then
MsgBox "Holidays on this date are fully booked.", vbOKOnly, "Requested Date Unavailable"
Exit Sub
End If
Next Cell
End If
End If
End With
With nRange
Set Rng3 = .Find(What:=FindName, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng3 Is Nothing Then
Set oRange = Sheets(Department).Range(Sheets(Department).Cells(Rng3.Row, Rng1.Column), Sheets(Department).Cells(Rng3.Row, Rng2.Column))
HolRequested = oRange.Cells.Count
HolRemaining = Left(Sheets("Request Form").Range("B13").Value, InStr(Sheets("Request Form").Range("B13").Value, " ") - 1)
If HolRequested < HolRemaining Then
oRange.Interior.ColorIndex = 6
oRange.Value = "Booked"
LastRowHidden = Sheets("Hidden Sheet").Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Hidden Sheet").Range("A2:A" & LastRowHidden)
Set Rng4 = .Find(What:=FindName, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng4 Is Nothing Then
Rng4.Offset(0, 3).Value = Rng4.Offset(0, 3).Value - HolRequested
End If
End With
MsgBox "Holiday request successfully recorded.", vbOKOnly, "Request Received"
Sheets("Request Form").Range("B7").ClearContents
Sheets("Request Form").Range("B21:C21").ClearContents
Else
MsgBox "You do not have enough holiday remaining to cover this request", vbOKOnly, "Attention!"
End If
End If
End With
Else
With dRange
Set Rng1 = .Find(What:=FindStart, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng1 Is Nothing Then
If Application.WorksheetFunction.CountA(Range(Sheets(Department).Cells(2, Rng1.Column), Sheets(Department).Cells(LastRow, Rng1.Column))) > 1 Then
MsgBox "Holidays on this date are fully booked.", vbOKOnly, "Requested Date Unavailable"
Exit Sub
End If
End If
End With
With nRange
Set Rng3 = .Find(What:=FindName, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng3 Is Nothing Then
Set oRange = Sheets(Department).Cells(Rng3.Row, Rng1.Column)
HolRequested = 1
HolRemaining = Left(Sheets("Request Form").Range("B4").Value, InStr(Sheets("Request Form").Range("B13").Value, " ") - 1)
If HolRequested < HolRemaining Then
oRange.Interior.ColorIndex = 6
oRange.Value = "Booked"
LastRowHidden = Sheets("Hidden Sheet").Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Hidden Sheet").Range("A2:A" & LastRowHidden)
Set Rng4 = .Find(What:=FindName, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng4 Is Nothing Then
Rng4.Offset(0, 3).Value = Rng4.Offset(0, 3).Value - HolRequested
End If
End With
MsgBox "Holiday request successfully recorded.", vbOKOnly, "Request Received"
Sheets("Request Form").Range("B7").ClearContents
Sheets("Request Form").Range("B21:C21").ClearContents
Else
MsgBox "You do not have enough holiday remaining to cover this request", vbOKOnly, "Attention!"*
End If
End If
End With
End If
End Sub
Aucun commentaire:
Enregistrer un commentaire