Assigning values of one dynamic array through a loop to another one with changes (VBA)

user_19910314 0
Viewed 45

I'm new to the VBA programming language so I'm asking for some help.

I'm trying to automatize building a waterfall chart in Excel using VBA. Usually I did everything manually and it often took quite a while when data changed. So I decided to use VBA to fasten the process.

To create a waterfall chart, I need to create additional series of data. I'm trying to do it by using arrays and loops.

For one, I need to create an array which consists of absolute values of the initial array (range). But I run into an error "Subscript out of range" and can't figure out what the problem is. In Python, which I know better, I guess, there wouldn't be such a problem.

Here's my code:

 Sub CreateWaterfall()
'*************************************************************************
    Dim i As Integer
'*************************************************************************
' Turn a range into an array
    Dim FigureArrayLength As Integer
    FigureArrayLength = Range("B3", Range("B3").End(xlToRight)).Count
    
    Dim FiguresArr() As Variant
    ReDim FiguresArr(FigureArrayLength)
    FiguresArr = Range("B3", Range("B3").End(xlToRight))
'*************************************************************************
' Build another array based on FiguresArr, but making all the values positive
    Dim AuxiliaryFiguresArr() As Variant
    ReDim AuxiliaryFiguresArr(FigureArrayLength)
    
    For i = 1 To FigureArrayLength
        AuxiliaryFiguresArr(i) = Abs(FiguresArr(i))
    Next i
    
End Sub

What Excel doesn't like is this line, which gets highlighted in yellow when I press the 'Debug' button:

AuxiliaryFiguresArr(i) = Abs(FiguresArr(i))

What could the problem be?

vba excel
2 Answers

Absolute Values of a Row to an Array

Sub ArrAbsRowTEST()
    
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the one-row range ('rrg') (a pretty risky way).
    Dim rrg As Range: Set rrg = ws.Range("B3", ws.Range("B3").End(xlToRight))
        
    ' Using the 'ArrAbsRow' function (on the range),
    ' write the converted values to an array ('Arr').
    Dim Arr() As Variant: Arr = ArrAbsRow(rrg)
    
    ' Continue, e.g.:
    Debug.Print "The array contains the following numbers:"
    Debug.Print Join(Arr, vbLf)
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the absolute values of the values from the first row
'               of a range ('rrg') in a 1D one-based array.
' Remarks:      It is assumed that the first row of the range
'               contains numbers only.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrAbsRow( _
    ByVal rrg As Range) _
As Variant
    
    ' Write the values from the first row of the range
    ' to a 2D one-based one-row array ('rData').
    
    Dim rData() As Variant
    Dim cCount As Long
    
    With rrg.Rows(1)
        cCount = .Columns.Count
        If cCount = 1 Then ' one cell
            ReDim rData(1 To 1, 1 To 1): rData(1, 1) = .Value
        Else ' multiple cells
            rData = .Value
        End If
    End With
    
    ' Write the absolute values of the values from the 2D array
    ' to the resulting 1D one-based array ('Arr').
    
    Dim Arr() As Variant: ReDim Arr(1 To cCount)
    
    Dim c As Long
    
    For c = 1 To cCount
        Arr(c) = Abs(rData(1, c))
    Next c
    
    ' Assign the 1D array to the result.
    
    ArrAbsRow = Arr
    
End Function
user_98140690

I tested the below and returned to this page and then saw the solution from VBasic2008; so thought I'd add my answer too.

When I first did this, I assumed that the range derived array would be one dimensional too. I realised my mistake, when I added the array as a watch and was then able to see its dimensions.


    Option Explicit
    
    Private Sub CreateWaterfall()
    '*************************************************************************
        Dim i As Integer
        Dim WS As Worksheet
        Set WS = ThisWorkbook.Sheets("Sheet1")
    '*************************************************************************
    ' Turn a range into an array
        Dim FiguresArr As Variant
        FiguresArr = WS.Range("B3", WS.Range("B3").End(xlToRight))
    '*************************************************************************
    ' Build another array based on FiguresArr, but making all the values positive
        ReDim AuxiliaryFiguresArr(0, 0) As Variant
        AuxiliaryFiguresArr(0, 0) = 0
        
        For i = 1 To UBound(FiguresArr, 2)
            Call AddEntry(AuxiliaryFiguresArr, Abs(FiguresArr(1, i)))
        Next i
        
    End Sub

The procedure below is called by the code above


    Public Sub AddEntry(aList As Variant, aEntry As Variant)
    
    '
    ' build array for later copy onto sheet
    '
    
    Dim i%
    Dim aEntry2 As Variant
    
    If VarType(aEntry) = vbDouble Or VarType(aEntry) = vbInteger Then
        aEntry2 = Array(aEntry)
    Else
        aEntry2 = aEntry
    End If
    
    If aList(0, 0) <> 0 Then
        ReDim Preserve aList(0 To UBound(aEntry2), 0 To UBound(aList, 2) + 1)
    End If
    
    For i = 0 To UBound(aEntry2)
        aList(i, UBound(aList, 2)) = aEntry2(i)
    Next
                
    End Sub
user_19702430
Related