Select the weekday that your schedule will start in Excel

Let me teach you the VBA that I have learn in my five years of consulting

Become an Affiliate and earn 25% on Course Sales

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

Contact me regarding customizing this template for your needs.

Click for online Excel Consulting

Check out Crowdcast for creating your webinars

If you need to buy Office 2019 follow

I use Tube Buddy to help promote my videos
Check them out

Follow me on Facebook

TWEET THIS VIDEO

Follow me on twitter
easyexcelanswers

*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.
code
Sub pickthestart()
Dim i, y As Integer
Dim num As Integer
Dim cnt As Integer
Dim c As Long
Dim r, sun As Integer
Dim startpos As Range
Dim rng As Range
Dim fstwk As Long
Dim findstring As String

sun = 1

findstring = sun
With Sheets(“Sheet1”).Range(“b2:J2”)
Set rng = .Find(What:=findstring, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With

fstwk = (rng.Column)
For r = 5 To 19

If (r = 5 Or r = 6 Or r = 7) Then
y = fstwk
Sheet1.Cells(r, y).Select
cnt = 1
Do While cnt (less than or equa)l 4
ActiveCell.Value = “M”
ActiveCell.Offset(0, 1).Value = “M”
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 3)).Value = “A”
Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 5)).Value = “N”
ActiveCell.Offset(0, 6).Value = “O”
ActiveCell.Offset(0, 7).Select
cnt = cnt + 1
Loop
End If

If (r = 8 Or r = 9 Or r = 10) Then
y = fstwk
Sheet1.Cells(r, y).Select
cnt = 1
Do While cnt (less than or equa)4
ActiveCell.Value = “O”

Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Value = “M”
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 4)).Value = “A”
Range(ActiveCell.Offset(0, 5), ActiveCell.Offset(0, 6)).Value = “N”
ActiveCell.Offset(0, 7).Select
cnt = cnt + 1

Loop

End If

If (r = 11 Or r = 12 Or r = 13) Then
y = fstwk
Sheet1.Cells(r, y).Select
cnt = 1
Do While cnt (less than or equa)4
ActiveCell.Value = “N”
ActiveCell.Offset(0, 1).Value = “O”
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 3)).Value = “M”
Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 5)).Value = “A”
ActiveCell.Offset(0, 6).Value = “N”
ActiveCell.Offset(0, 7).Select
cnt = cnt + 1

Loop

End If

If (r = 14 Or r = 15 Or r = 16) Then
y = fstwk
Sheet1.Cells(r, y).Select
cnt = 1
Do While cnt (less than or equa)4
ActiveCell.Value = “N”
ActiveCell.Offset(0, 1).Value = “N”
ActiveCell.Offset(0, 2).Value = “O”
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 4)).Value = “M”
Range(ActiveCell.Offset(0, 5), ActiveCell.Offset(0, 6)).Value = “A”
ActiveCell.Offset(0, 7).Select
cnt = cnt + 1

Loop

End If
If (r = 17 Or r = 18 Or r = 19) Then
y = fstwk
Sheet1.Cells(r, y).Select
cnt = 1
Do While cnt (less than or equa)4
ActiveCell.Value = “A”

Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Value = “N”
ActiveCell.Offset(0, 3).Value = “O”
Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 5)).Value = “M”
ActiveCell.Offset(0, 6).Value = “A”
ActiveCell.Offset(0, 7).Select
cnt = cnt + 1

Loop

End If

Next r
End Sub

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