please help me :( im stuck

new_b

New Member
Joined
Jul 29, 2002
Messages
21
ok I have a spreadsheet which works out staffs rota, holidays and shift patterns, the problem I have is when I click on the button to launch the macro "holiday form" it takes me to a "leave sheet" which sorts out the bank holidays etc from the rota sheet. Anyway for some reason if I give a member of staff the 01/01/03 off as holiday (because its meant to be their shift) on the holiday form under bank holiday 01/01/03 its ok but it also repeats the same info 2 or 3 cells down against another bank holiday date which is obviously wrong. I must have something wrong with the code, can someone please look at it as i dont understand it and posibly let me know where its gone wrong.

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
Else
Sheets("Leave Sheet").Cells(ph, 4) = .Cells(a, 2) & " " & mon
ph = ph + 1
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


Thanks T
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Can you post an example of your leave sheet? That may make it easier to see what's going on.
 

new_b

New Member
Joined
Jul 29, 2002
Messages
21

ADVERTISEMENT

test2.xls
ABCDE
24
25BankHolidaysDutyActualDateTakenPHTaken
2601January8.5PH1JanuaryX
2718April8PH18AprilX
2821AprilRR1JanuaryX
2905May242418April
3025MayRR25DecemberX
3126MayRR26DecemberX
3224AugustRRX
3325August2424
3425December8.5PH25DecemberX
3526December8PH26DecemberX
36
Leave Sheet


I hope this works, thanks mate

T
 

new_b

New Member
Joined
Jul 29, 2002
Messages
21
is there anything I can do to help you guys spot the problem, I really need to find out whats wrong here.


thanks
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
The offending code is:

Code:
Else
   Sheets("Leave Sheet").Cells(ph, 4) = .Cells(a, 2) & " " & mon 
   ph = ph + 1

just before loopa:

I don't pretend to understand why it's there, but it seems to work if you remove it.
 

new_b

New Member
Joined
Jul 29, 2002
Messages
21
THANK YOU Andrew, it worked a treat, now that means I can get on with the rest of it, If I get any more questions I will post again.

thanks again for your help.
 

Forum statistics

Threads
1,143,925
Messages
5,721,562
Members
422,372
Latest member
RoyRodger

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