Modify a schedule Automatically for vacation in Excel

Modify a schedule Automatically for vacation in Excel. Modify a schedule Automatically when vacation is entered in Excel. Assign shifts to others when vacation is indicated in Excel.
This code will allow you to transfer shifts to another person when vacation is entered. If no other person is available then it will tell you which shifts need to be covered for the Vacation. How to test if a cell is empty. How to test if a range is empty.

Code
Sub engshift()
Dim r As Integer
Dim z As Integer
Dim y As Integer

msg = “Please enter the number of employees you would like to schedule”
QtyEntry = InputBox(msg)
z = QtyEntry + 4

y = z + 1

r = 5
For r = 5 To z

If r = 5 Or r = 6 Or r = 15 Then
Worksheets(“sheet1”).Cells(r, 3).Select
If Not IsEmpty(ActiveCell.Value) = True Then
Worksheets(“sheet1”).Cells(y, 3).Value = “A”
Else
ActiveCell.Value = “A”
End If

If WorksheetFunction.CountA(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2))) = 0 Then
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Value = “A”
Else
Range(Cells(y, 4), Cells(y, 5)).Value = “A”
End If
If WorksheetFunction.CountA(Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 9))) = 0 Then
Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 9)).Value = “M”
Else
Range(Cells(y, 9), Cells(y, 12)).Value = “M”
End If
If WorksheetFunction.CountA(Range(ActiveCell.Offset(0, 12), ActiveCell.Offset(0, 14))) = 0 Then
Range(ActiveCell.Offset(0, 12), ActiveCell.Offset(0, 14)).Value = “N”
Else
Range(Cells(y, 15), Cells(y, 17)).Value = “N”
End If

If WorksheetFunction.CountA(Range(ActiveCell.Offset(0, 17), ActiveCell.Offset(0, 20))) = 0 Then
Range(ActiveCell.Offset(0, 17), ActiveCell.Offset(0, 20)).Value = “A”
Else
Range(Cells(y, 20), Cells(y, 23)).Value = “A”
End If
If WorksheetFunction.CountA(Range(ActiveCell.Offset(0, 23), ActiveCell.Offset(0, 26))) = 0 Then
Range(ActiveCell.Offset(0, 23), ActiveCell.Offset(0, 26)).Value = “M”
Else
Range(Cells(y, 26), Cells(y, 29)).Value = “M”
End If
ActiveCell.Offset(0, 29).Select
If Not IsEmpty(ActiveCell.Value) = True Then
Worksheets(“sheet1”).Cells(y, 32).Value = “A”
Else
ActiveCell.Value = “A”
End If

End If

next r
end sub

For more help visit my website or email me at easyexcelanswers@gmail.com.

Contact me regarding customizing this template for your needs.

Excel one-on-one on-line training available. Email me to arrange.

I am able to provide online help on your computer at a reasonable rate.

Check out my next one-hour Excel Webinar

Check out Crowdcast for creating your webinars

If you need to buy Office 2019 follow

Follow me on Facebook

Follow me on twitter
easyexcelanswers

IG @barbhendersonconsulting

You can help and generate a translation to you own language

*this description may contain affiliate links. When you click them, I may receive a small commission at no extra cost to you. I only recommend products and services that I’ve used or have experience with.

Watch more new videos about Excel Office | Synthesized by Mindovermetal English