CODEWITHSUNDEEP
excelvbacustom-functions-excel
Dumitru Daniel
Dumitru Daniel

Reputation: 549

Emula VSTACK formula in VBA because it's not yet available on all computers

I was stoked to find about VSTACK and HSTACK formulas, because I could trim down some huge formulas, by merging multiple named ranges with VSTACK, and then using index to find a sum in a specified column, using a formula like: =SUM(INDEX(vStack(VBA_REG_NIS1,VBA_REG_NIS2,VBA_REG_NIS3),,COLUMN()-@COLUMN(VBA_REG_NIS1)+1))

Than I was dissapointed to find that not all computers in my company have the new formula, so I was thinking maybe I can replicate the functionality in VBA. I tried using the formula below, but when I applied the sum(index(vStack_clone that I mentioned earlier, I noticed that I'm only getting the total from the first named range, as if the Union actually does horizontal stacking.

Function vStack_clone(ParamArray ranges() As Variant) As Range
    Dim I As Long
    
    For I = LBound(ranges) To UBound(ranges)
        If I = LBound(ranges) Then
            Set vStack_clone = ranges(I)
        Else
            Set vStack_clone = Union(vStack_clone, ranges(I))
        End If
    Next
End Function

Can anyone help me clone the VSTACK formula, maybe tell me what I did wrong?

Upvotes: 1

Views: 2910

Answers (2)

VBasic2008
VBasic2008

Reputation: 54807

VSTACK RANGES UDF

  • The result of the following function as well as the result of Excel's VSTACK function is not a range but an array.
  • Note that functions like COUNTIF, SUMIF...etc. work only with ranges and you won't be able to use them.

enter image description here

Function VStackRanges(ParamArray Ranges() As Variant) As Variant
    
    Dim LB As Long, UB As Long: LB = LBound(Ranges): UB = UBound(Ranges)
    Dim sData(): ReDim sData(LB To UB)
    Dim srCounts(): ReDim srCounts(LB To UB)
    Dim scCounts(): ReDim scCounts(LB To UB)
    
    Dim Data(), n As Long, drCount As Long, dcCount As Long
    
    For n = LB To UB
        srCounts(n) = Ranges(n).Rows.Count
        scCounts(n) = Ranges(n).Columns.Count
        drCount = drCount + srCounts(n)
        If scCounts(n) > dcCount Then dcCount = scCounts(n)
        If srCounts(n) * scCounts(n) = 1 Then
            ReDim Data(1 To 1, 1 To 1): Data(1, 1) = Ranges(n).Value
        Else
            Data = Ranges(n).Value
        End If
        sData(n) = Data
    Next n
    
    ReDim Data(1 To drCount, 1 To dcCount)
    
    Dim sr As Long, sc As Long, dr As Long
    
    For n = LB To UB
        For sr = 1 To srCounts(n)
            dr = dr + 1
            For sc = 1 To scCounts(n)
                Data(dr, sc) = sData(n)(sr, sc)
            Next sc
        Next sr
    Next n
    
    VStackRanges = Data

End Function

Upvotes: 1

Spencer Barnes
Spencer Barnes

Reputation: 2877

The Union doesn't work for discontiguous ranges, so it's only picking up the first range argument you enter.

The below code works for me, but I have only tried it in MS365:

Function vStack_clone(ParamArray ranges() As Variant) As Variant
    Dim lWidth As Long, lHeight As Long, tmpOutput As Variant
    Dim a As Long, x As Long, y As Long, SeriesY As Long
    
    'Set spill range dimensions
    For a = LBound(ranges) To UBound(ranges)
        If ranges(a).Columns.Count > lWidth Then lWidth = ranges(a).Columns.Count
        lHeight = lHeight + ranges(a).Rows.Count
    Next
    
    ReDim tmpOutput(1 To lHeight, 1 To lWidth)
    SeriesY = 1

    'Enter Values
    For a = LBound(ranges) To UBound(ranges)
        For y = 1 To ranges(a).Rows.Count
            For x = 1 To ranges(a).Columns.Count
                tmpOutput(SeriesY, x) = ranges(a).Cells(y, x)
            Next
            SeriesY = SeriesY + 1
        Next
    Next
    
    vStack_clone = tmpOutput
    
End Function

Upvotes: 0

Related Questions