How to union multiple ranges and show it in a listbox of a VBA form

I try to union multiple ranges, but the result is alway just two columns where it should be more.

    With ActiveSheet

      lastRow = .Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

      Set rng1 = .Range("A1:F" & .Cells(.Rows.Count, "A").End(xlUp).Row)
      Set rng2 = Union(.Range("A1:B" & lastRow), .Range("E1:F" & lastRow))
    
      With lb
        .List = rng1.Value
        .ColumnWidths = "100;200;100;100;100;100"
        .ColumnCount = 6
      End With
   End With

The above code is just for testing. When I bind rng1 to te listbox list property, it works as expected. Multiple columns show in the listbox.

When I bind rng2 to the listbox, only two columns are drawn (just the values of the first range).

What am I doing wrong here?

Solution

Stack Range Areas Horizontally

If rng is a set range, then the expression rng.Value on the right side of an equation means that it is a 2D one-based array with the same values and the same number of rows and columns as the first area of that range unless the first area is a single cell when the expression is equal to the cell's value.
You could create a function that would return the values of a multi-area range in a single 2D one-based array. Then your code would look like this:

With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set rng2 = Union(.Range("A1:B" & LastRow), .Range("E1:F" & LastRow))
    
    With lb
        .List = GetHStackedAreas(rng2)
        .ColumnWidths = "100;200;100;100"
        .ColumnCount = 4
    End With
End With

The Function

Function GetHStackedAreas(ByVal rg As Range) As Variant

    Dim AreasCount As Long: AreasCount = rg.Areas.Count
    Dim rcData() As Variant: ReDim rcData(1 To AreasCount, 1 To 2)
        
    Dim arg As Range, a As Long, RowsCount As Long, ColumnsCount As Long
    
    ' Map the number of rows and columns per area to an array,
    ' and calculate the maximum number of rows and the number of total columns.
    For Each arg In rg.Areas
        a = a + 1
        rcData(a, 1) = arg.Rows.Count
        If rcData(a, 1) > RowsCount Then RowsCount = rcData(a, 1)
        rcData(a, 2) = arg.Columns.Count
        ColumnsCount = ColumnsCount + rcData(a, 2)
    Next arg
    
    ' Define the resulting array.
    Dim Data() As Variant: ReDim Data(1 To RowsCount, 1 To ColumnsCount)
    a = 0
        
    Dim aData() As Variant, r As Long, c As Long, Col As Long
        
    ' Populate the resulting array.
    For Each arg In rg.Areas
        ' Return the values of each area in a helper array.
        a = a + 1
        If rcData(a, 1) * rcData(a, 2) = 1 Then ' single cell
            ReDim aData(1 To 1, 1 To 1): aData(1, 1) = arg.Value
        Else ' multiple cells
            aData = arg.Value
        End If
        ' Populate the resulting array with values from the helper array.
        For r = 1 To rcData(a, 1)
            For c = 1 To rcData(a, 2)
                Data(r, Col + c) = aData(r, c)
            Next c
        Next r
        Col = Col + c - 1
    Next arg
    
    GetHStackedAreas = Data
    
End Function

A Worksheet Test

Sub Test()
    
    ' Reference the range.
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range: Set rg = Union( _
        ws.Range("A2:B6"), _
        ws.Range("E2:F11"), _
        ws.Range("H2:H8"))
        
    ' Get horizontally stacked areas.
    Dim Data() As Variant: Data = GetHStackedAreas(rg)
    
    ' Return in worksheet.
    ws.Range("J2").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
    
    ' Return in listbox.
'    With lb
'        .List = Data
'        .ColumnCount = UBound(Data, 2)
'    End With
    
End Sub

Note that in MS365 you could achieve almost the same with the following formula:
```
=IFNA(HSTACK(A2:C6,E2:F11,H2:H8),"")
```
The only difference is that the formula returns empty strings instead of empty cells.