Adding the Last Few Features to my Scheduling Template Generator - excel

Question

Thanks to some wonderful people here on StackOverflow I have almost completed the code for my scheduling template generator! I just have three more things I would like to add that I am having some trouble with.
Current Breakdown: I have two sheets - "2 - Staff Listing" and "X - Template"
-The Values in in the staff listing sheet are a column of staff names beginning in Cell D9
-Then the Staff values are transferred to the template sheets starting in Cell B6
-There is a drop-down menu in the template sheet in Cell C2 where you can select which template you want to make just as an example it could read 5 Week or 5 Week with AM/PM
-Based on this Key I have it repeating each staff member's names X amount of times (5 in this case) and double that if AM/PM is selected so 10 times in this case
What I am hoping to still achieve:
-In the template sheet I would like column C to be the week number and column D to show AM/PM.
-So, for a 5 week AM/PM Template you would have Column C staring in cell C6 list Week 1, Week 1, Week 2, Week 2, up to Week 5. So, once for each week in the Key if it is AM/PM it should appear twice once for AM and once for PM.
-Then I would like it to list AM starting in cell D6 and then go PM and just keep repeating for the length of the names in column B. Additionally, if it is not an AM/PM template then I would like to hide column D.
Below is the code I currently have.
Sub populate_Template()
Worksheets("X - Template").Range("B6:K1000").ClearContents
Dim SourceData As Range
Set SourceData = Sheets("2 - Staff Listing").Range("D9")
Dim RepititionCell As Range
Set RepititionCell = Sheets("X - Template").Range("C2")
Dim Destination As Range
Set Destination = Sheets("X - Template").Range("B6")
Dim lr As Long
Dim arr As Variant
With SourceData.Parent
lr = .Cells(.Rows.count, SourceData.Column).End(xlUp).Row
arr = .Range(SourceData, .Cells(lr, SourceData.Column)).Value
End With
Dim repetition As Long
If Right(RepititionCell, 5) = "AM/PM" Then repetition = Split(RepititionCell.Value, " ")(0) * 2 Else repetition = Split(RepititionCell.Value, " ")(0)
Dim newarr() As String
ReDim newarr(1 To (lr - SourceData.Row + 1) * repetition, 1 To 1)
Dim count As Long
count = 0
Dim i As Long
For i = LBound(arr) To UBound(arr)
Dim y As Long
For y = 1 To repetition
count = count + 1
newarr(count, 1) = arr(i, 1)
Next y
Next i
Destination.Resize(UBound(newarr) - LBound(newarr) + 1).Value = newarr
End Sub

Answer 1

First you need to dim newarr to have three columns instead of one:
ReDim newarr(1 To (lr - SourceData.Row + 1) * repetition, 1 To 3)
Then your For y Next loop should fill in those other two columns. You can use the Mod operator to determine if you're on an odd or even row.
For y = 1 To repetition
Count = Count + 1
newarr(Count, 1) = arr(i, 1)
'if you're doubling up. You may want to put this in a Boolean variable
'to reduce code duplication
If Right(RepititionCell, 5) = "AM/PM" Then
'if it's an odd number
If y Mod 2 = 1 Then
newarr(Count, 2) = "Week " & (y + 1) / 2
newarr(Count, 3) = "AM"
Else 'even number
newarr(Count, 2) = "Week " & y / 2
newarr(Count, 3) = "PM"
End If
Else
'not doubling up, so y is the week number and nothing in column D
newarr(Count, 2) = "Week " & y
End If
Next y
Finally, you have to change your write line to account for the new columns
Destination.Resize(UBound(newarr, 1), UBound(newarr, 2)).Value = newarr
I got rid of the LBound part of the Resize because you're starting at 1 anyway. It's less robust if you happen to start your array at some other number. But between the likelihood that would happen and the improved readability, I think it's better.