oh no more help, hopefully easy : (

new_b

New Member
Joined
Jul 29, 2002
Messages
21
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
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
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

New Member
Joined
Jul 29, 2002
Messages
21
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
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

New Member
Joined
Jul 29, 2002
Messages
21

ADVERTISEMENT

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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
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

New Member
Joined
Jul 29, 2002
Messages
21
Andrew

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

thanks

Colin
 

Forum statistics

Threads
1,144,122
Messages
5,722,604
Members
422,447
Latest member
knopp

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top