I hope you are all well and had a great holiday season.
I was wondering if anyone can help me. I would like to know how to add a new variable to the code below that I am using for a holiday request form.
Basically when The user requests the holiday it copies their request to their teams calendar and providing the dates are available then below the dates appears the term "booked"
Currently this is set to 2 people off for all teams but I would like to know how I can enter a variable to alter this fror each team
so that If Team X is entered in Sheet 1 Range A1 allow 2 people off and if Team Y Is entered sheet 1 Range A1 allow 1 person off
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("Request Form").Range("B11").Value
Name = Team & Replace(Sheets("Request Form").Range("B7").Value, " ", "")
LastRow = Sheets(Team).Cells(Rows.Count, "A").End(xlUp).Row
If Sheets("Request Form").Range("B21").Value = Sheets("Request Form").Range("C21").Value Then
StartRng = Left(Sheets("Request Form").Range("B21").Value, 2) & Mid(Sheets("Request Form").Range("B21").Value, 4, 2) & Right(Sheets("Request Form").Range("B21").Value, 2)
If Sheets("Request Form").Range("D21").Value <> "" Then
ShiftRng = Sheets("Request Form").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
Else
Range("DateRequest").Select
Selection.ClearContents
MsgBox " Not Booked"
End If
Else
StartRng = Left(Sheets("Request Form").Range("B21").Value, 2) & Mid(Sheets("Request Form").Range("B21").Value, 4, 2) & Right(Sheets("Request Form").Range("B21").Value, 2)
EndRng = Left(Sheets("Request Form").Range("C21").Value, 2) & Mid(Sheets("Request Form").Range("C21").Value, 4, 2) & Right(Sheets("Request Form").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
If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "AM ") Then
bookedstring = bookedstring & (Sheets("CS").Cells(1, Cell.Column).Text & " (AM) Booked" & vbCr)
Else
If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "PM") Then
bookedstring = bookedstring & (Sheets("CS").Cells(1, (Cell.Column - 1)).Text & " (PM) Booked" & vbCr)
End If
End If
Else
Range("DateRequest").Select
Selection.ClearContents
If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "AM ") Then
bookedstring = bookedstring & (Sheets("CS").Cells(1, Cell.Column).Text & " (AM) Not Booked" & vbCr)
Else
If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "PM") Then
bookedstring = bookedstring & (Sheets("CS").Cells(1, (Cell.Column - 1)).Text & " (PM) Not Booked" & vbCr)
End If
End If
End If
Next Cell
MsgBox bookedstring
DateCopy.DateCopy
End If
any help would be greatly appreciated and please ask any questions :)