Excel VBA: Issues with setting Range Union - vba

Question

I have the following code created by #ScottCraner which populates cells Q8:Q12 with the dates of each friday this month.
Sub myFri()
Dim OArr(1 To 5, 1 To 1) As Variant
Dim k As Long
k = 1
Dim i As Long
For i = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0)
If Weekday(i, vbSunday) = 7 Then
OArr(k, 1) = i
k = k + 1
End If
Next i
If k = 5 Then OArr(k, 1) = "-"
Worksheets("Sheet1").Range("Q8:Q12").Value = OArr
Worksheets("Sheet1").Range("Q8:Q12").NumberFormat = "mm/dd/yyyy"
End Sub
I have adjusted this to try and set the range to different sections of the sheet.
Ive done this with a Union range as follows:
Private Sub DateRangePayer1()
Dim rng1, rng2, rng3, rng4, UnionRange As Range
Set rng1 = Range("Q8:Q12")
Set rng2 = Range("T8:T12")
Set rng3 = Range("Q16:Q20")
Set rng4 = Range("T16:T20")
Set UnionRange = Union(rng1, rng2, rng3, rng4)
Dim OArr(1 To 5, 1 To 1) As Variant
Dim k As Long
k = 1
Dim i As Long
For i = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0)
If Weekday(i, vbSunday) = 6 Then
OArr(k, 1) = i
k = k + 1
End If
Next i
If k = 5 Then OArr(k, 1) = "-"
UnionRange.Value = OArr
UnionRange.NumberFormat = "dd-mmmm"
End Sub
Unfortunately, its currently not working as expected and is populating the cells with the following format:
It populates ranges Q8:Q12 and Q16:Q20 perfectly however, when filling in row T, it loops through the first friday of this month only.
Thank you all for your help with this so far. Youve all been amazingly helpful and all your time is appreciated. Special thanks to #ScottCraner for all your help with everything I have submitted so far.

Answer 1

You cannot fill a discontiguous union range with one array like that. Probably best to use 5 arrays or one array and slice off the pieces or run through the Areas of the unioned range.
Private Sub dateRangePayer1()
Dim unionRange As Range, uRng As Range
Dim d As Long, k As Long
Set unionRange = Worksheets("sheet8").Range("Q8:Q12, T8:T12, Q16:Q20, T16:T20")
'Set unionRange = ActiveSheet.Range("Q8:Q12, T8:T12, Q16:Q20, T16:T20") deals with the active sheet
ReDim OArr(1 To 5, 1 To 1) As Variant
For d = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0)
If Weekday(d, vbSunday) = 6 Then
k = k + 1
OArr(k, 1) = d
End If
Next d
If k = 4 Then OArr(k + 1, 1) = "-"
For Each uRng In unionRange.Areas
uRng.Value = OArr
uRng.NumberFormat = "dd-mmmm"
Next uRng
End Sub

Answer 2

As advised by Jeeped, I substituted the Union Range for individual references. Code changes as follows. If theres a more efficient/neater way of doing this, I would love to know:
Private Sub DateRangePayer1()
'Credit to #Pᴇʜ for pointing out the Array flaw. Corrected this.
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Set rng1 = Range("Q8:Q12")
Set rng2 = Range("T8:T12")
Set rng3 = Range("Q16:Q20")
Set rng4 = Range("T16:T20")
Dim OArr(1 To 5, 1 To 1) As Variant
Dim k As Long
k = 1
Dim i As Long
For i = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0)
If Weekday(i, vbSunday) = 6 Then
OArr(k, 1) = i
k = k + 1
End If
Next i
If k = 5 Then OArr(k, 1) = "-"
rng1.Value = OArr
rng1.NumberFormat = "dd-mmmm"
rng2.Value = OArr
rng2.NumberFormat = "dd-mmmm"
rng3.Value = OArr
rng3.NumberFormat = "dd-mmmm"
rng4.Value = OArr
rng4.NumberFormat = "dd-mmmm"
End Sub