How to make an automatic 12hour shift schedule. Automatically create a 12hour rotating schedule. Check out my templates page for free and purchased templates https://www.easyexcelanswers.com/temp...


Sub twelve()
Dim x As Integer
Dim y, w As Integer
x = 5

y = 0
For x = 5 To 13
Sheet1.Cells(x, (3 + y)).Select

ActiveCell.Value = "D"
If y (does not equal) 0 Then
ActiveCell.Offset(0, 1).Value = "O"
End If
If y = 2 Then
ActiveCell.Offset(0, 2).Value = "O"
End If
If y = 3 Then
ActiveCell.Offset(0, 3).Value = "O"
End If
If y = 4 Then
ActiveCell.Offset(0, 4).Value = "N"
End If
If y = 5 Then
ActiveCell.Offset(0, 5).Value = "N"
End If
If y = 6 Then
ActiveCell.Offset(0, 6).Value = "N"
End If
If y = 7 Then
ActiveCell.Offset(0, 7).Value = "O"
End If
If y = 8 Then
ActiveCell.Offset(0, 8).Value = "O"
End If
If y = 9 Then
ActiveCell.Offset(0, 2).Value = "O"
End If
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Value = "D"
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 5)).Value = "O"
Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 8)).Value = "N"
Range(ActiveCell.Offset(0, 9), ActiveCell.Offset(0, 11)).Value = "o"
Range(ActiveCell.Offset(0, 12), ActiveCell.Offset(0, 14)).Value = "d"
Range(ActiveCell.Offset(0, 15), ActiveCell.Offset(0, 17)).Value = "o"
Range(ActiveCell.Offset(0, 18), ActiveCell.Offset(0, 20)).Value = "n"
Range(ActiveCell.Offset(0, 21), ActiveCell.Offset(0, 23)).Value = "o"
If y = 0 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "D"
Range(ActiveCell.Offset(0, 27), ActiveCell.Offset(0, 29)).Value = "O"
ActiveCell.Offset(0, 30).Value = "N"
End If
If y = 1 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "D"
Range(ActiveCell.Offset(0, 27), ActiveCell.Offset(0, 29)).Value = "O"
End If

If y = 2 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "D"
Range(ActiveCell.Offset(0, 27), ActiveCell.Offset(0, 28)).Value = "O"
End If
If y = 3 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "D"
ActiveCell.Offset(0, 27).Value = "O"
End If
If y = 4 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "D"

End If

If y = 5 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 25)).Value = "D"

End If
If y = 6 Then
ActiveCell.Offset(0, 24).Value = "D"

End If
y = y + 1

Next x

w = 0
For x = 14 To 21
Sheet1.Cells(x, (3 + w)).Select
'ActiveCell = ActiveCell.Offset(0, 1)

ActiveCell.Value = "N"
If w (does not equal) 0 Then
ActiveCell.Offset(0, 1).Value = "O"
End If
If w = 2 Then
ActiveCell.Offset(0, 2).Value = "O"
End If
If w = 3 Then
ActiveCell.Offset(0, 3).Value = "O"
End If
If w = 4 Then
ActiveCell.Offset(0, 4).Value = "D"
End If
If w = 5 Then
ActiveCell.Offset(0, 5).Value = "D"
End If
If w = 6 Then
ActiveCell.Offset(0, 6).Value = "D"
End If
If w = 7 Then
ActiveCell.Offset(0, 7).Value = "O"
End If
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Value = "N"
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 5)).Value = "O"
Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 8)).Value = "D"
Range(ActiveCell.Offset(0, 9), ActiveCell.Offset(0, 11)).Value = "o"
Range(ActiveCell.Offset(0, 12), ActiveCell.Offset(0, 14)).Value = "n"
Range(ActiveCell.Offset(0, 15), ActiveCell.Offset(0, 17)).Value = "o"
Range(ActiveCell.Offset(0, 18), ActiveCell.Offset(0, 20)).Value = "d"
Range(ActiveCell.Offset(0, 21), ActiveCell.Offset(0, 23)).Value = "o"
If w = 0 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "N"
Range(ActiveCell.Offset(0, 27), ActiveCell.Offset(0, 29)).Value = "O"
ActiveCell.Offset(0, 30).Value = "N"
End If
If w = 1 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "N"
Range(ActiveCell.Offset(0, 27), ActiveCell.Offset(0, 29)).Value = "O"
End If

If w = 2 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "N"
Range(ActiveCell.Offset(0, 27), ActiveCell.Offset(0, 28)).Value = "O"
End If
If w = 3 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "N"
ActiveCell.Offset(0, 27).Value = "O"
End If
If w = 4 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 26)).Value = "N"

End If

If w = 5 Then
Range(ActiveCell.Offset(0, 24), ActiveCell.Offset(0, 25)).Value = "N"

End If
If w = 6 Then
ActiveCell.Offset(0, 24).Value = "O"

End If



w = w + 1

Next x
End Sub
For more help visit my website http://www.easyexcelanswers.com
*this description may contain affiliate links.