VBA shift scheduler

S

ssm84

New Member
Joined
Jun 15, 2020
Messages
25
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
  2. Mobile
Hello everyone!
I'm here to humbly ask for your help on VBA ... considering I'm still sooo impractical about VBA .....
I'm trying to create a staff shift scheduler.
I thought it was a simple project .... but I guess I ran aground ....
As per attached file, I hypothesized a H24 7 days a week system. which are repeated month by month (clearly dynamically and not statically)
The system repeats the following way
1= PP RR NN RR M M
2= RR MM PP RR N N
3= NN RR MM PP RR
4= MM PP RR N N RR
5= RR NN RR MM PP

where P= Pomeridian
R= Rest
N= Night
M= Mornings
so, 1= 2 days of pomeridian, 2 days rest, 2 nights, 2 rest, 2 mornings....rinse and repeat lol


The part of the code, on the other hand, which should write the shifts on all the lines does not work ... I select the shift of group 1 it writes the relative shift only on the first line ... I started writing the code where I automatically enter dates / gg, and so far everything is fine. I did not understand how to write...


VBA Code: 
Sub ins1()
Dim ID As Integer

Range("D6").Select
Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
ID = ActiveCell.Offset(-1, 0).Range("a1") - 37883
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = "P"
Case 2 To 3
ActiveCell.Value = ""
Case 4 To 5
ActiveCell.Value = "N"
Case 6 To 7
ActiveCell.Value = ""
Case 8 To 9
ActiveCell.Value = "M"
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop

Range("D7").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = "P"
Case 2 To 3
ActiveCell.Value = ""
Case 4 To 5
ActiveCell.Value = "N"
Case 6 To 7
ActiveCell.Value = ""
Case 8 To 9
ActiveCell.Value = "M"
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop


Range("D8").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = ""
Case 2 To 3
ActiveCell.Value = "M"
Case 4 To 5
ActiveCell.Value = "P"
Case 6 To 7
ActiveCell.Value = "N"
Case 8 To 9
ActiveCell.Value = ""
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop

Range("D9").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = ""
Case 2 To 3
ActiveCell.Value = "M"
Case 4 To 5
ActiveCell.Value = "P"
Case 6 To 7
ActiveCell.Value = "N"
Case 8 To 9
ActiveCell.Value = ""
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop

Range("D10").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = "N"
Case 2 To 3
ActiveCell.Value = ""
Case 4 To 5
ActiveCell.Value = "M"
Case 6 To 7
ActiveCell.Value = "P"
Case 8 To 9
ActiveCell.Value = ""
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop

Range("D11").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = "N"
Case 2 To 3
ActiveCell.Value = ""
Case 4 To 5
ActiveCell.Value = "M"
Case 6 To 7
ActiveCell.Value = "P"
Case 8 To 9
ActiveCell.Value = ""
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop


Range("D12").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = "M"
Case 2 To 3
ActiveCell.Value = "P"
Case 4 To 5
ActiveCell.Value = ""
Case 6 To 7
ActiveCell.Value = "N"
Case 8 To 9
ActiveCell.Value = ""
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop




Range("D13").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = "M"
Case 2 To 3
ActiveCell.Value = "P"
Case 4 To 5
ActiveCell.Value = ""
Case 6 To 7
ActiveCell.Value = "N"
Case 8 To 9
ActiveCell.Value = ""
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop


Range("D14").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = ""
Case 2 To 3
ActiveCell.Value = "N"
Case 4 To 5
ActiveCell.Value = ""
Case 6 To 7
ActiveCell.Value = "M"
Case 8 To 9
ActiveCell.Value = "P"
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop

Range("D15").Select

Do While ActiveCell.Offset(-1, 0).Range("a1").Value <> ""
Select Case Right(ID, 1)
Case 0 To 1
ActiveCell.Value = ""
Case 2 To 3
ActiveCell.Value = "N"
Case 4 To 5
ActiveCell.Value = ""
Case 6 To 7
ActiveCell.Value = "M"
Case 8 To 9
ActiveCell.Value = "P"
Case Else
MsgBox "Error...You Should never see this"
End Select
ActiveCell.Offset(0, 1).Range("a1").Select
Loop


End Sub



The best solution would be for the code to read the last two days of the previous month and write the new one....but not there yet as knowledge necessary XD

any help?
attached link to sample file
Sample File
 
Sort by date Sort by votes
You're welcome & thanks for the feedback.
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
On the final assembly of the FILE I discovered that the formula works in almost all dates.
But if you open the file (as it is) it is on august and on that month the formula does not work... strange
 
Upvote 0
They are codes, not formula. A formula is something you put in a sheet.

Which code is not working (I've given you three)
 
Upvote 0
@Fluff , you are right! Thanks for correcting terminology.

The code that is "glitching" on the august date ( at the moment the only one I have seen the error) is the following:
VBA Code: 
Sub Rows17_19()
   Dim Ary As Variant, Shft As Variant, WkDays As Variant
   Dim r As Long, c As Long, x As Long, y As Long, z As Long
   Dim Itm As Boolean
   
   Shft = Array("M", "P")
                
   r = Range("B17").End(xlDown).Row
   c = Range("D5").End(xlToRight).Column
   Ary = Range("D17", Cells(r, c)).Value
   WkDays = Range("D3", Cells(3, c)).Value
   
   If WkDays(1, 1) > 5 Then
      Itm = meccanico <> "M"
   Else
      Itm = meccanico = "M"
   End If
   
   For r = 1 To UBound(Ary) - 1
      Itm = Not Itm
      For c = 1 To UBound(Ary, 2)
         Select Case WkDays(1, c)
            Case 1 To 5
               Ary(r, c) = Shft(-Itm)
            Case 6
               Ary(r, c) = ""
               Itm = Not Itm
            Case Else
               Ary(r, c) = ""
         End Select
      Next c
   Next r
   Range("D17").Resize(UBound(Ary), UBound(Ary, 2)).Value = Ary

End Sub



what is coming out is the following


sample1.JPG



instead of alternating. The code, instead looks like is working in other cases
 
Upvote 0
Ok, how about
VBA Code: 
Sub Rows17_19()
   Dim Ary As Variant, Shft As Variant, WkDays As Variant
   Dim r As Long, c As Long, x As Long, y As Long, z As Long
   Dim Itm As Boolean
   
   Shft = Array("M", "P")
                
   r = Range("B17").End(xlDown).Row
   c = Range("D5").End(xlToRight).Column
   Ary = Range("D17", Cells(r, c)).Value
   WkDays = Range("D3", Cells(3, c)).Value
   
   Itm = UCase(meccanico) = "M"
   
   For r = 1 To UBound(Ary) - 1
      Itm = Not Itm
      For c = 1 To UBound(Ary, 2)
         Select Case WkDays(1, c)
            Case 1 To 5
               Ary(r, c) = Shft(-Itm)
            Case 6
               Ary(r, c) = ""
               If c > 2 Then Itm = Not Itm
            Case Else
               Ary(r, c) = ""
         End Select
      Next c
   Next r
   Range("D17").Resize(UBound(Ary), UBound(Ary, 2)).Value = Ary

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question
VBA InputBox without entry quitting Sub/Macro
Replies
1
Views
112
Micron
M
SanjayGMusafir
  • Solved
VBA to add new record - Declaring variable
2
Replies
14
Views
154
Micron
M
S
  • Question
VBA Duplicates
Replies
1
Views
202
Alex Blakenburg
A
G
  • Question
Converting and copying specific data
Replies
1
Views
142
GerrardSVK
G
F
  • Question
How to get optionbutton values from two different groups
Replies
2
Views
245
NoSparks
N

Forum statistics

Threads
1,215,046
Messages
6,122,854
Members
449,096
Latest member
Erald

Share this page

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
Back
Top