How to change VBA one-dimensional array output from horizontal to vertical?

user_9788072 0
Viewed 385

In the below VBA subroutine I generate an array ("ArrSim") of random numbers, such array measuring 10 rows x 3 columns. This array is pasted into cells A1:C10 of the active worksheet when running the sub. I then generate another array ("ArrRowAvg") where an average is calculated for each row of the ArrSim array. This works fine. The results of this 2nd array, ArrRowAvg, is pasted horizontally into the worksheet in cells E1:N1.

How do I change the code so that ArrRowAvg is instead pasted vertically, always two columns to the right of the ArrSim array? The below code is abbreviated & some of the input variables hard-coded for sake of simplicity; in the full code the user inputs the desired size of ArrSim. I just need to know how to make ArrRowAvg paste vertically. I´ve fiddled with the transpose and index functions with no luck.

Sub Testing()

'   Clear contents of active worksheet and move cursor to Cell A1
    Cells.Clear
    Range("A1").Select

'   Declarations of variables and arrays
    Dim i As Long, j As Integer
    Dim ArrSim() As Double
    Dim OutputSim As Range
     
'   Redimension array
    ReDim ArrSim(1 To 10, 1 To 3)
   
'   Set worksheet range
    Set OutputSim = ActiveCell.Range(Cells(1, 1), Cells(10, 3))
  
'   Fill ArrSim with random values
    For i = 1 To 10
        For j = 1 To 3
            ArrSim(i, j) = Application.RandBetween(0, 100)
        Next j
    Next i

'   Transfer ArrSim to Worksheet
    OutputSim.Value = ArrSim

'   Generate 1-dimensional array to store the row averages
    Dim ArrRowAvg, ArrRow
    ReDim ArrRowAvg(10 - 1)
        
'   Loop to calculate row averages from above ArrSim and feed into new array
    For i = 0 To UBound(ArrSim, 1) - 1
        ArrRow = Application.Index(ArrSim, i + 1, 0)
        ArrRowAvg(i) = WorksheetFunction.Average(ArrRow)
    Next i

'   Paste the array ArrRowAvg values starting one column to the right of OutputSim
    OutputSim.Offset(0, 1 + OutputSim.Columns.Count).Resize(1, UBound(ArrRowAvg) + 1).Value = ArrRowAvg
        
End Sub
vertical-alignment vba excel arrays
2 Answers

Please, use this code line:

OutputSim.Offset(0, 1 + OutputSim.Columns.count).Resize(UBound(ArrRowAvg) + 1, 1).Value = Application.Transpose(ArrRowAvg)

instead of:

OutputSim.Offset(0, 1 + OutputSim.Columns.Count).Resize(1, UBound(ArrRowAvg) + 1).Value = ArrRowAvg
user_22333080

2D One-Column One-Based Array(s)

A Quick Fix

Option Explicit

Sub Testing()

    Const FirstCell As String = "A1"
    Const rCount As Long = 10
    Const cCount As Long = 3

'   Clear contents of active worksheet and move cursor to Cell A1
    Cells.Clear
    Dim cel As Range: Set cel = Range(FirstCell)
    cel.Select

'   Declarations of variables and arrays
    Dim i As Long, j As Long
    Dim ArrSim() As Long
    Dim OutputSim As Range
     
'   Redimension array
    ReDim ArrSim(1 To rCount, 1 To cCount)
   
'   Fill ArrSim with random values
    For i = 1 To rCount
        For j = 1 To cCount
            ArrSim(i, j) = Application.RandBetween(0, 100)
        Next j
    Next i

'   Set worksheet range
    Set OutputSim = cel.Resize(rCount, cCount)

'   Transfer ArrSim to Worksheet
    OutputSim.Value = ArrSim

'   Generate 2-dimensional array to store the row averages
    Dim ArrRowAvg() As Double
    Dim ArrRow As Variant
    ReDim ArrRowAvg(1 To rCount, 1 To 1)
        
'   Loop to calculate row averages from above ArrSim and feed into new array
    For i = 1 To rCount
        ArrRow = Application.Index(ArrSim, i, 0)
        ArrRowAvg(i, 1) = Application.Average(ArrRow)
    Next i

'   Paste the array ArrRowAvg values starting one column to the right of OutputSim
    OutputSim.Columns(1).Offset(, cCount).Value = ArrRowAvg
        
End Sub

My Choice

Sub myChoice()

    ' Constants
    Const FirstCell As String = "A1"
    Const rCount As Long = 10
    Const cCount As Long = 3

    ' Arrays    
    Dim tcCount As Long: tcCount = cCount + 1
    Dim Data() As Double: ReDim Data(1 To rCount, 1 To tcCount)
    Dim DataRow As Variant
    Dim i As Long, j As Long
    For i = 1 To rCount
        For j = 1 To cCount
            Data(i, j) = Application.RandBetween(0, 100)
        Next j
        DataRow = Application.Index(Data, i, 0)
        Data(i, tcCount) = Application.Sum(DataRow) / cCount
    Next I

    ' Worksheet    
    Application.ScreenUpdating = False
    Cells.Clear
    With Range(FirstCell)
        .Select
        .Resize(rCount, tcCount).Value = Data
    End With
    Application.ScreenUpdating = True
    
End Sub
user_98140690
Related