Array Data To WorkSheet (1D or 2D)

Visual Basic for Applications · Wikibooks

0%

Contents

    Text

    Size
    100%
    Theme
    Typeface
    Line length
    Spacing

    From Wikibooks, under CC BY-SA 4.0, as the source states it. This page at Wikibooks.

    Summary

    This MS Excel VBA code listing transfers data from a one or two dimensional array to a worksheet.

    Code Notes

    • Arr1Dor2DtoWorksheet() transfers data from an array to a specified worksheet, and at a specified location within it. It takes one-dimensional or two-dimensional arrays, and is able to distinguish between them, prior to the transfer. Non-array inputs are detected as are arrays that are not allocated. One-dimensional arrays are transferred into a sheet row in all cases. Two-dimensional arrays are displayed in the same row and column shape as in the array. There are no facilities in the procedure to transpose data, but procedures exist elsewhere in this series for that purpose.

    The VBA Module

    • Copy the entire code listing into a VBA standard module and run the top procedure. Save the worksheet as type .xlsm. Comment and de-comment lines in the top procedure and adjust parameters to test the main procedure.
    Sub TestArr1Dor2DtoWorksheet()

    Dim vB As Variant, vC As Variant, a() As String, sE As String
    Dim r As Long, c As Long, oSht As Worksheet
    
    'preliminaries
    Set oSht = ThisWorkbook.Worksheets("Sheet2")
    oSht.Activate
    oSht.Cells.Clear
    oSht.Cells(1, 1).Select
    
    'load a one dimensional array to test
    'vB = Array("a", "b", "c", "d") 'array and allocated one dimension
    vB = Split("A B C D E F G H I J K L M", " ")
    'load a two dimensional array to test
    ReDim vC(1 To 4, 1 To 4)
    For r = 1 To 3
        For c = 1 To 4
            vC(r, c) = CStr(r & "," & c)
        Next c
    Next r
    
    'Use these to test if input filters
    'Arr1Dor2DtoWorksheet sE, "Sheet2", 3, 3        'run to test not-an-array feature
    'Arr1Dor2DtoWorksheet a(), "Sheet2", 3, 3       'run to test not-allocated feature
    
    'print arrays on sheet
    Arr1Dor2DtoWorksheet vB, "Sheet2", 2, 2        '1D to sheet row
    Arr1Dor2DtoWorksheet vC, "Sheet2", 5, 2        '2D to sheet range

End Sub

Private Function Arr1Dor2DtoWorksheet(vA As Variant, ByVal sSht As String, _
                         ByVal nRow As Long, ByVal nCol As Long) As Boolean
    
    'Transfers a one or two dimensioned input array vA to the worksheet,
    'with top-left element at cell position nRow,nCol. sSht is the worksheet name.
    'Default 2D array transfers are made unchanged and a 1D array is displayed in a row.
            
    Dim oSht As Worksheet, rng As Range, rng1 As Range, bProb As Boolean
    Dim nD As Integer, nR As Integer, nDim As Integer, r As Long, c As Long
    Dim LBR As Long, UBR As Long, LBC As Long, UBC As Long, vT As Variant
    
    'CHECK THE INPUT ARRAY
    On Error Resume Next
        'is it an array
        If IsArray(vA) = False Then
            bProb = True
        End If
        'check if allocated
        nR = UBound(vA, 1)
        If Err.Number <> 0 Then
            bProb = True
        End If
    Err.Clear
        
    If bProb = False Then
        'count dimensions
        On Error Resume Next
        Do
            nD = nD + 1
            nR = UBound(vA, nD)
        Loop Until Err.Number <> 0
    Else
        MsgBox "Parameter is not an array" & _
        vbCrLf & "or is unallocated - closing."
        Exit Function
    End If
    'get number of dimensions
    Err.Clear
    nDim = nD - 1: 'MsgBox nDim

    'get ref to worksheet
    Set oSht = ThisWorkbook.Worksheets(sSht)
       
    'set a worksheet range for array
    Select Case nDim
    Case 1 'one dimensional array
        LBR = LBound(vA): UBR = UBound(vA)
        Set rng = oSht.Range(oSht.Cells(nRow, nCol), oSht.Cells(nRow, nCol + UBR - LBR))
    Case 2 'two dimensional array
        LBR = LBound(vA, 1): UBR = UBound(vA, 1)
        LBC = LBound(vA, 2): UBC = UBound(vA, 2)
        Set rng = oSht.Range(oSht.Cells(nRow, nCol), oSht.Cells(nRow + UBR - LBR, nCol + UBC - LBC))
    Case Else 'unable to print more dimensions
        MsgBox "Too many dimensions - closing"
        Exit Function
    End Select

    'transfer array values to worksheet
        rng.Value = vA
    
    'release object variables
    Set oSht = Nothing
    Set rng = Nothing
    
    'returns
    Arr1Dor2DtoWorksheet = True

End Function

    See Also