Excel VBA: Issues with setting Range Union

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.

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. — user4039065
– user4039065, Commented Aug 2, 2018 at 8:46
Right! Ill get on it :) Thank you for the advice Jeeped. I swear you dont sleep XD — Batteredburrito
– Batteredburrito, Commented Aug 2, 2018 at 8:47

Batteredburrito · Accepted Answer · 2018-08-02 09:05:30Z

2

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

edited Aug 2, 2018 at 9:05

Batteredburrito

5991 gold badge7 silver badges38 bronze badges

answered Aug 2, 2018 at 8:59

user4039065

Sign up to request clarification or add additional context in comments.

Comments

Batteredburrito · Accepted Answer · 2018-08-02 09:07:19Z

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

edited Aug 2, 2018 at 9:07

answered Aug 2, 2018 at 8:51

Batteredburrito

5991 gold badge7 silver badges38 bronze badges

1 Comment

Pᴇʜ Over a year ago

Please note that Dim rng1, rng2, rng3, rng4 As Range only declares rng4 as type Range but all the others as type Variant. You need to specify a type for every variable in VBA: Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range

Collectives™ on Stack Overflow

Excel VBA: Issues with setting Range Union

2 Answers 2

Comments

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related