Delgore62
07-08-2014, 03:01 PM
Sub MySchedule()
Application.ScreenUpdating = False
Dim XTime As Variant, NewXTime As Variant ' ----- Used for printing my timeframe on schedule
Dim WeekSection As Integer
Set Master = Sheet1 ' ----- sheet where main database is stored -----
Dim WeekTab(5, 1) 'rem ----- setup tab vaiables -----
For WeekSection = 0 To 28 Step 7
WeekTab((WeekSection / 7) + 1, 1) = _
"WK " & Format(((7 - Weekday(Master.Range("Month").Cells(2, 1))) + _
Master.Range("Month").Cells(2, 1) + WeekSection), "mmdd")
Next WeekSection
' ----- Generate left 3 columns on each schedule -----
For TabNum = 1 To 5
' Sheets(TabNum + 1).Name = WeekTab(TabNum, 1)
For DaySet = 10 To 94 Step 14
' ----- Print my timeframe onto schedule -----
For Person = 18 To 19 ' ----- 18 is myself, 19 is guard/relief ----
XTime = Worksheets(WeekTab(TabNum, 1)).Cells(DaySet + 13, Person).Value
For a = 1 To Len(XTime)
NewXTime = NewXTime & Mid(XTime, a, 1) & " "
Next a
Worksheets(WeekTab(TabNum, 1)).Cells(DaySet, Person - 16).Value = NewXTime
NewXTime = vbNullString
Next Person
Next DaySet
Next TabNum
End Sub
Application.ScreenUpdating = False
Dim XTime As Variant, NewXTime As Variant ' ----- Used for printing my timeframe on schedule
Dim WeekSection As Integer
Set Master = Sheet1 ' ----- sheet where main database is stored -----
Dim WeekTab(5, 1) 'rem ----- setup tab vaiables -----
For WeekSection = 0 To 28 Step 7
WeekTab((WeekSection / 7) + 1, 1) = _
"WK " & Format(((7 - Weekday(Master.Range("Month").Cells(2, 1))) + _
Master.Range("Month").Cells(2, 1) + WeekSection), "mmdd")
Next WeekSection
' ----- Generate left 3 columns on each schedule -----
For TabNum = 1 To 5
' Sheets(TabNum + 1).Name = WeekTab(TabNum, 1)
For DaySet = 10 To 94 Step 14
' ----- Print my timeframe onto schedule -----
For Person = 18 To 19 ' ----- 18 is myself, 19 is guard/relief ----
XTime = Worksheets(WeekTab(TabNum, 1)).Cells(DaySet + 13, Person).Value
For a = 1 To Len(XTime)
NewXTime = NewXTime & Mid(XTime, a, 1) & " "
Next a
Worksheets(WeekTab(TabNum, 1)).Cells(DaySet, Person - 16).Value = NewXTime
NewXTime = vbNullString
Next Person
Next DaySet
Next TabNum
End Sub