oh no more help, hopefully easy : (

[new_b]

Hi again, sorry

this macro along with doing lots of other stuff works out somewhere when a member of staff is taking a public holiday leave "PH" on a date that isnt a public holiday, ie if they work a bank holiday they get to have another day as holiday but it gets booked as a ph, does that make sense? ok so the following macro is working ok but when I book the user on a "PH" day in the "Rota" sheet on a day that isnt a public holiday the macro is not recording it on the "Leave Sheet" can someone please see where this bit of code is, or what bit of code I need to add in to sort this out.

thanks again and sorry

colin heres the code

Sub Holiday_Form()

v = 0

With Sheets("Leave Sheet")
.[A4:E4].ClearContents
.[E7].ClearContents
.[D9:E12].ClearContents
.[D16:E22].ClearContents
.[B26:E100].ClearContents
.[A37].ClearContents
.[A26:E100].Interior.ColorIndex = xlNone
End With

Sheets("Data").[C1:E100].ClearContents

With Sheets("Rota")
a = 20
b = 1
Do
If .Cells(2, a) <> "" Then
Sheets("Data").Cells(b, 3) = .Cells(2, a)
Sheets("Data").Cells(b, 4) = .Cells(1, a)
Sheets("Data").Cells(b, 5) = .Cells(2, a) & " " & .Cells(1, a)
b = b + 1
End If
a = a + 1
Loop Until a = 72
End With

With Sheets("Data")
.[C1:E100].Sort key1:=.[D1], order1:=xlAscending, header:=xlNo
.[C1:E100].HorizontalAlignment = xlLeft
End With

With Which_Officer
.offr.ColumnCount = 1
.offr.RowSource = ("Data!E1:E100")
.Show

If v = 1 Then GoTo quitt
officer = .offr
End With

With Sheets("Data")
c = 1
Do Until .Cells(c, 5) = officer
c = c + 1
Loop
off1 = .Cells(c, 3)
off2 = .Cells(c, 4)
End With

Sheets("Leave Sheet").[A4] = officer

grp1 = ""
With Sheets("Data")
d = 1
Do
If .Cells(d, 21) = off2 Then grp1 = .Cells(d, 22)
d = d + 1
Loop Until d = 12
End With

With Sheets("rota")
d = 1
Do Until .Cells(1, d) & .Cells(2, d) = off2 & off1
d = d + 1
Loop

e = d
Do Until .Cells(5, e) <> ""
e = e - 1
Loop
grp2 = Int(Right(.Cells(5, e), 1))
End With

If grp1 = "" Then grp1 = grp2

Sheets("Leave Sheet").[E7] = "GROUP " & grp2

f = 10
Do Until Sheets("Data").Cells(1, f) = grp1
f = f + 1
Loop

g = 10
Do Until Sheets("Data").Cells(1, g) = grp2
g = g + 1
Loop

With Sheets("Leave Sheet")
.[B26] = Sheets("Data").Cells(2, f)
.[B27] = Sheets("Data").Cells(109, f)
.[B28] = Sheets("Data").Cells(112, f)
.[B29] = Sheets("Data").Cells(126, g)
.[B30] = Sheets("Data").Cells(146, g)
.[B31] = Sheets("Data").Cells(147, g)
.[B32] = Sheets("Data").Cells(237, g)
.[B33] = Sheets("Data").Cells(238, g)
.[B34] = Sheets("Data").Cells(360, g)
.[B35] = Sheets("Data").Cells(361, g)

.[C26] = Sheets("Rota").Cells(6, d)
.[C27] = Sheets("Rota").Cells(113, d)
.[C28] = Sheets("Rota").Cells(116, d)
.[C29] = Sheets("Rota").Cells(130, d)
.[C30] = Sheets("Rota").Cells(150, d)
.[C31] = Sheets("Rota").Cells(151, d)
.[C32] = Sheets("Rota").Cells(241, d)
.[C33] = Sheets("Rota").Cells(242, d)
.[C34] = Sheets("Rota").Cells(364, d)
.[C35] = Sheets("Rota").Cells(365, d)



c = 26
Do
Select Case .Cells(c, 2)
Case "R"
If .Cells(c, 3) = "R" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "PH" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
Range(.Cells(c, 1), .Cells(c, 5)).Interior.ColorIndex = 3
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "PH booked on a R on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "A" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "BL" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5).Interior.ColorIndex = 1
.Cells(c, 5) = "X"
MsgBox "B leave booked on a R on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "LS" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "LS leave booked on a R on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "L" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "S" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 8 Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 8.5 Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 24 Then
If off1 = "DO" Then phtot = phtot + 1 Else phtot = phtot + 1.5
End If
c = c + 1
Case 8
If .Cells(c, 3) = "R" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "R booked on an 8 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "PH" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "A" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "BL" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "B leave booked on an 8 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "LS" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "LS leave booked on an 8 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "L" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "S" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 8 Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 8.5 Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 24 Then
If off1 = "DO" Then phtot = phtot + 1 Else phtot = phtot + 1.5
End If
c = c + 1
Case 8.5
If .Cells(c, 3) = "R" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "R booked on an 8.5 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "PH" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "A" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "BL" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "B leave booked on an 8.5 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "LS" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "LS leave booked on an 8.5 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "L" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "S" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 8 Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 8.5 Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 24 Then
If off1 = "DO" Then phtot = phtot + 1 Else phtot = phtot + 1.5
End If
c = c + 1
Case 24
If .Cells(c, 3) = "R" Then
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
MsgBox "R booked on a 24 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "PH" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "A" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "BL" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
MsgBox "B leave booked on a 24 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "LS" Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
Range(.Cells(c, 1), .Cells(c, 3)).Interior.ColorIndex = 3
MsgBox "LS leave booked on a 24 PH on " & .Cells(c, 1) & "!", vbOKOnly, "SILLY BILLY!"
ElseIf .Cells(c, 3) = "L" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = "S" Then
.Cells(c, 4) = .Cells(c, 1)
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 8 Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 8.5 Then
.Cells(c, 5) = "X"
.Cells(c, 5).Interior.ColorIndex = 1
ElseIf .Cells(c, 3) = 24 Then
If off1 = "DO" Then phtot = phtot + 1 Else phtot = phtot + 1.5
End If
c = c + 1
Case Else
c = c + 1
End Select
Loop Until c = 37
If off1 = "DO" Then
.[E26:E35] = "X"
.[E26:E35].Interior.ColorIndex = 1
End If
End With

With Sheets("Rota")
a = 6
al = 9
bl = 16
ls = 20
ph = 26
hph = 26
ol = 37
aph = 37

Do
If .Cells(a, 1) <> "" Then mon = .Cells(a, 1)
Select Case .Cells(a, d)
Case "A"
dat = .Cells(a, 2) & " " & mon
b = a + 6
Do
a = a + 1
If .Cells(a, 1) <> "" Then mon = .Cells(a, 1)
Loop Until a = b
dat = dat & " - " & .Cells(a, 2) & " " & mon
Sheets("Leave Sheet").Cells(al, 4) = dat
a = a + 1
al = al + 1
Case "BL"
If bl = 19 Then
MsgBox "Too many B leaves! " & .Cells(a, 2) & " " & mon & " cannot be taken as a B leave!", vbOKOnly, "ERROR!"
Else
Sheets("Leave Sheet").Cells(bl, 4) = .Cells(a, 2) & " " & mon
bl = bl + 1
End If
a = a + 1
Case "LS"
If ls = 23 Then
MsgBox "Too many Long Service leaves! " & .Cells(a, 2) & " " & mon & " cannot be taken as a Long Service leave!", vbOKOnly, "ERROR!"
Else
Sheets("Leave Sheet").Cells(ls, 4) = .Cells(a, 2) & " " & mon
ls = ls + 1
End If
a = a + 1
Case "PH"
b = 1
Do
If .Cells(a, 2) & " " & mon = Sheets("Data").Cells(b, 9) Then GoTo loopa
b = b + 1
Loop Until b = 12
Do Until Sheets("Leave Sheet").Cells(ph, 4) = ""
ph = ph + 1
Loop
If ph >= 36 Then
If hph < 36 Then
Do Until Sheets("Leave Sheet").Cells(hph, 5) = ""
hph = hph + 1
If hph >= 36 Then
MsgBox "Too many PH leaves! " & .Cells(a, 2) & " " & mon & " cannot be taken as a PH!", vbOKOnly, "ERROR!"
Sheets("Leave Sheet").[D37] = "Additional PH's"
Sheets("Leave Sheet").Cells(aph, 5) = .Cells(a, 2) & " " & mon
aph = aph + 1
GoTo loopa
End If
Loop
Sheets("Leave Sheet").Cells(hph, 5) = "½ " & .Cells(a, 2) & " " & mon
Do Until Sheets("Leave Sheet").Cells(hph, 5) = ""
hph = hph + 1
If hph = 36 Then
MsgBox "Too many PH leaves! " & .Cells(a, 2) & " " & mon & " cannot be taken as a PH!", vbOKOnly, "ERROR!"
Sheets("Leave Sheet").[D37] = "Additional PH's"
Sheets("Leave Sheet").Cells(aph, 5) = .Cells(a, 2) & " " & mon
aph = aph + 1
GoTo loopa
End If
Loop
Sheets("Leave Sheet").Cells(hph, 5) = "½ " & .Cells(a, 2) & " " & mon
Else
MsgBox "Too many PH leaves! " & .Cells(a, 2) & " " & mon & " cannot be taken as a PH!", vbOKOnly, "ERROR!"
Sheets("Leave Sheet").[D37] = "Additional PH's"
Sheets("Leave Sheet").Cells(aph, 5) = .Cells(a, 2) & " " & mon
aph = aph + 1
GoTo loopa
End If
End If
loopa:
a = a + 1
Case ".PH"
Do Until Sheets("Leave Sheet").Cells(hph, 5) = ""
hph = hph + 1
Loop
If hph >= 36 Then
MsgBox "Too many PH leaves! " & .Cells(a, 2) & " " & mon & " cannot be taken as a half PH", vbOKOnly, "ERROR!"
Sheets("Leave Sheet").[D37] = "Additional PH's"
Sheets("Leave Sheet").Cells(aph, 5) = "½ " & .Cells(a, 2) & " " & mon
aph = aph + 1
Else
Sheets("Leave Sheet").Cells(hph, 5) = .Cells(a, 2) & " " & mon
hph = hph + 1
End If
a = a + 1
Case 12
Do Until Sheets("Leave Sheet").Cells(hph, 5) = ""
hph = hph + 1
Loop
If hph >= 36 Then
MsgBox "Too many PH leaves! " & .Cells(a, 2) & " " & mon & " cannot be taken as a half PH", vbOKOnly, "ERROR!"
Sheets("Leave Sheet").[D37] = "Additional PH's"
Sheets("Leave Sheet").Cells(aph, 5) = "½ " & .Cells(a, 2) & " " & mon
aph = aph + 1
Else
Sheets("Leave Sheet").Cells(hph, 5) = .Cells(a, 2) & " " & mon
hph = hph + 1
End If
a = a + 1
Case "+12"
Do Until Sheets("Leave Sheet").Cells(hph, 5) = ""
hph = hph + 1
Loop
If hph >= 36 Then
MsgBox "Too many PH leaves! " & .Cells(a, 2) & " " & mon & " cannot be taken as a half PH", vbOKOnly, "ERROR!"
Sheets("Leave Sheet").[D37] = "Additional PH's"
Sheets("Leave Sheet").Cells(aph, 5) = "½ " & .Cells(a, 2) & " " & mon
aph = aph + 1
Else
Sheets("Leave Sheet").Cells(hph, 5) = .Cells(a, 2) & " " & mon
hph = hph + 1
End If
a = a + 1
Case 2000
Sheets("Leave Sheet").[A37] = "2000 Leave O/s"
Sheets("Leave Sheet").Cells(ol, 2) = .Cells(a, 2) & " " & mon
ol = ol + 1
a = a + 1
Case Else
a = a + 1
End Select
Loop Until a = 371
End With

Sheets("Leave Sheet").Select

quitt:
End Sub

 

[Andrew Poulsom]

Just a thought - should it be .PH if they take a day in lieu of a Public Holiday?

There is a statement:

Case ".PH"

just after loopa:

 

[new_b]

Hi Andy

.PH is actually if you take half a day and PH is for a full day.

Is there some code that I can just add somewhere to rectify this.

Thanks

Colin

 

[Andrew Poulsom]

OK

So who have you booked on a "PH" day in the "Rota" sheet on a day that isnt a public holiday? And what is the date?

 

[new_b]

Ok here goes:-

goto Rota sheet and under "DO ALLEN" on the 3rd Oct, click on the number 8 and then click on the "change cell" button and select "PH" after you have done that, click on the "holiday Form" button and select DO Allen from the list, highlight his name and then ok, this should take you to the leave sheet. scroll down abit to the dates and in there against one of the bank holiday dates it should put in 3rd October under the heading actual taken.

Hope this makes sense.

Thanks

Colin

 

[Andrew Poulsom]

If I do that I get:

D26 1 January
D27 1 January
D28 3 October

Is it that your rota is at fault? Should each officer have as many PH days as there are public holidays?

The first part of the code puts the public holiday date in column D if column C contains "PH". The next part searches for "PH" in the rota and puts the date in the next blank cell in column D. That's why it repeats 1 January and then stores 3 October. Maybe this bit should test if the date is already in Column D.

 

[new_b]

Andrew

I have sent you another email via my work email address.

thanks

Colin