Visual Basic for Applications/Array Data To WorkSheet (1D or 2D)

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