Array to Excel Range - vba
I'm new to VBA and trying to write an array to an excel range through an array UDF.
I'm trying to output the array to a maximum number of rows that the formula was placed in. I am using the Microsoft Scripting Library for the dictionary, if that matters.
With an array formula in excel (CTRL+Shift+Enter), how do I resize my array to the range that the formula was placed in and then place the array in the cells?
I would like the formula on the cells to be =test("G1:J20") and the formula will be placed in the cells A1:B20.
Code:
Function test(ByVal inputRange As Range) As Variant
Dim Cell As Variant
Dim D As Dictionary
Dim Arr() As Variant
Dim i As Long
Set D = New Dictionary
' Remove duplicates
For Each Cell In inputRange
If D.Exists(CStr(Cell.Value)) = False Then
D.Add CStr(Cell.Value), 1
Else
D.Exists (Cell.Value)
D.Item(Cell.Value) = D.Item(Cell.Value) + 1
End If
Next
D.Remove vbNullString
Redim Arr(0 To Application.Max(D.Count, Application.Caller.Cells.Count))
'Fill the array with the keys from the Dictionary
For i = 0 To D.Count - 1
Arr(i) = D.Keys(i)
Next i
test = Application.Transpose(Arr)
End Function
To read and write arrays to cells you need a 2D array. For example:
Dim data() as Variant, N as Long, M as Long
' Say you want a 100×50 array
N = 100 : M = 50
ReDim data(1 to N, 1 to M)
' Fill data()
Range("A1").Resize(N,M).Value = data
Or to just read values
Dim data() as Variant, N as Long, M as Long, i as Long, j as Long
data = Range("A1:AX100").Value
N = UBOUND(data,1) : M = UBOUND(data,2)
For i = 1 to N
For j = 1 to M
Debug.Print(data(i,j))
Next j
Next i
Edit 1 I got rid of the evil Integer types and replaced them with Long, the native 32-bit integers in VBA.
Here is a method to put an array into a worksheet range, is this what you meant?
Sub test()
Dim v(0 To 2, 0 To 2) As Variant
Dim r As Range
'fill the array with values
populate v
'range must be same dimensions as array, in this case 3x3
Set r = ActiveSheet.Range("A1:C3")
'this simply puts array into range values
r.Value2 = v
End Sub
Function populate(v As Variant)
For i = 0 To 2
For j = 0 To 2
v(j, i) = i * j * j - i + 2
Next j
Next i
End Function
However, since you're already looping through the dictionary for the values, why not just write the values directly to the worksheet? You can mimic the transpose by swapping your row and column indices
Sub test()
Dim dict As Dictionary
Set dict = New Dictionary
'fill dictionary with values
populate dict
'loop through dictionary, and add items to worksheet
For i = 0 To dict.Count - 1
ActiveSheet.Cells(1, i + 1).Value = dict.Keys(i)
ActiveSheet.Cells(2, i + 1).Value = dict.Items(i)
Next i
End Sub
Function populate(dict As Dictionary)
dict.Add "help", "me"
dict.Add "I'm", "lost"
dict.Add "everything", "1"
dict.Add "or", "0"
End Function
Related
How to get range of cells into a specific array dimension
I need to get a range of cells into an array, which by itself is simple enough: Dim matchArray As Variant matchArray = Sheets(lookupSheet).Range("B2:B12000").Value2 This creates a two-dimensional array with one column as the second dimension and if you expand the range to include a second column it creates a two-dimensional array with two columns for the second dimension: matchArray = Sheets(lookupSheet).Range("B2:C12000").Value2 But what if the two columns aren't next to each other and you don't want the one in the middle? matchArray = Sheets(lookupSheet).Range("B2:B12000,D2:D12000").Value2 The above would be my best guess but it doesn't work, it only returns the first range specified. So what I need is a way to return a range cell values into a specific dimension of the array. I know I could do it by looping through the rows but that would take far too long with the number of rows I'm going to be working with.
You do need a loop -- but loop over VBA arrays rather than individual cells: Sub Test() Dim A As Variant, B As Variant, C As Variant Dim i As Long B = Sheets(lookupSheet).Range("B2:B12000").Value2 C = Sheets(lookupSheet).Range("D2:D12000").Value2 ReDim A(1 To 11999, 1 To 2) For i = 1 To 11999 A(i, 1) = B(i, 1) A(i, 2) = C(i, 2) Next i 'do stuff with A End Sub This should only take a fraction of a second.
You can do it with a ragged array: Dim var1(1 To 2) As Variant Dim var As Variant var = Range("A1:A10").Value2 var1(1) = var var = Range("c1:c10").Value2 var1(2) = var MsgBox var1(1)(3, 1)
Here are a couple more ways: Sub Example1() Const lookupSheet As String = "Sheet1" Dim matchArray As Variant, arr1 As Variant, arr2 As Variant With Sheets(lookupSheet) arr1 = WorksheetFunction.Transpose(.Range("B2:B12000").Value2) arr2 = WorksheetFunction.Transpose(.Range("D2:D12000").Value2) matchArray = WorksheetFunction.Transpose(Array(arr1, arr2)) End With End Sub Sub Example2() Const lookupSheet As String = "Sheet1" Dim matchArray As Variant Dim x As Long With Sheets(lookupSheet) matchArray = .Range("B2:B12000").Resize(, 2).Value2 For Each v In .Range("D2:D12000").Value2 x = x + 1 matchArray(x, 2) = v Next End With End Sub
Probably no quicker than John Coleman's answer, but I think this does what you want. Sub x() Dim matchArray, r As Range Set r = Sheets(lookupSheet).Range("B2:D12000") matchArray = Application.Index(r, Evaluate("Row(1:" & r.Rows.Count & ")"), Array(1, 3)) End Sub
copy a whole row from one matrix into another using vba
in one part of my code I read a matrix Dim matr As Variant, mat As Variant, vec As Variant matr = Worksheets("portfolio").Range("A2:K163") now after two if-loops I would like to copy the whole row into a new matrix For i = 1 To lngRow For j = 2 To ingRow If matr(i, 11) = matr(j, 11) Then If matr(i, 4) = matr(j, 4) Then matr(j,...)=mat(j,...) End If End If Next j Next i How can one copy the whole row from the existing matrix to another one?
If I understand your request correctly, here is some code which should help you. I've commented it for explanation. The main gist is this: mat grows in rows dynamically so that it can contain a new row of data from matr. Then this row is copied across. Of course if you allow mat to be initialised to the same size as matr and have many empty rows, you can ignore all the work with ReDim and just use the loop at the bottom to copy a row. Edit: I've edited this to take note of Preserve. From the docs, Preserve can only be used changing the last dimension. Because this isn't the case here, the data is copied to a temp array before new row is added. Option Base 1 Sub rr() ' Initialise 2D array to a range Dim matr As Variant Dim rng As Range Set rng = ActiveSheet.Range("A1:D7") matr = rng ' Range used so column count can be fetched easily Dim colCount As Long colCount = rng.Columns.Count ' Initialise empty 2D array for populating with given rows from matr Dim mat() As Variant Dim matTemp() As Variant ' Test conditions simplified for demo Dim someCondition As Boolean someCondition = True ' upper bound of mat, for testing if it is dimensioned Dim ub As Long Dim m As Long, n As Long Dim rowToCopy As Long For rowToCopy = 1 To 2 If someCondition = True Then ' test if dimensioned already ub = 0 On Error Resume Next ub = UBound(mat) On Error GoTo 0 If ub = 0 Then ' if no, dimension it to 1 row ReDim mat(1, colCount) Else ' if yes, dimension it to 1 extra row ReDim matTemp(ub + 1, colCount) For m = 1 To ub For n = 1 To colCount matTemp(m, n) = mat(m, n) Next n Next m ReDim mat(ub + 1, colCount) mat = matTemp End If ' Assign 'columns' of 2D array matr to new array mat For m = 1 To colCount mat(ub + 1, m) = matr(rowToCopy, m) Next m End If Next rowToCopy End Sub
VBA to extract names from a list at random isn't working
I want to randomly extract 280 names from a list (dynamic range) of thousands of authors, then concatenate them into 1 string with each name separated by OR. So far I'm stuck at the first part. When I run the following code, nothing happens. Can anyone explain why? Thanks. Sub Authors() Dim InputRange As Range Dim AuthorCount As Long Dim AuthorRange As Excel.Range Set InputRange = Range("A:A") AuthorCount = Application.WorksheetFunction.CountA(InputRange) - 1 Set AuthorRange = ThisWorkbook.Worksheets("Sheet").Range("A2:A" & AuthorCount) Const nItemsToPick As Long = 280 Dim Authorlist As Variant Dim i As Long ReDim Authorlist(1 To nItemsToPick) For i = 1 To nItemsToPick Authorlist(i) = AuthorRange.Cells(Int(AuthorCount * Rnd + 1), 1) Next i End Sub
Using the below code Sub PickSample(intSampleSize As Integer, intPicks As Integer) Dim arr() As String Dim intCounter As Integer ReDim arr(intPicks) For intCounter = 0 To UBound(arr) arr(intCounter) = CStr(Int((intSampleSize - (i - 1)) * Rnd + 1) + (i - 1)) Next intCounter Debug.Print Join(arr(), ",") End Sub I ran this on the following, PickSample(10,5) and got the following, showing the duplicate possibilities, this will become less as the difference between picks and samples increases. 9,9,6,10,10,2 5,3,6,7,2,3 10,4,5,8,0,6 9,8,4,10,9,0 0,8,8,7,0,4 7,5,6,3,3,8 If your selection is 280, but the data set is only 300, dupes still arise PickSample 300,280 228,**92**,248,216,269,66,**107**,166,**107**,61,174,189,41,18,190,252,192,127,56,149,292,231,114,145,164,202,11,194,270,102,35,128,232,**107**,124,225,131,216,152,52,83,26,294,85,186,**92**,256,96,239,52,90,21,148,136,179,9,95,40,98,228,188,290,249,166,182,57,271,95,180,179,230,215,206,228,77,165,153,170,84,125,105,292,156,175,139,9,113,41,196,46,59,112,28,185,211,132,126,101,210,64,13,266,13,138,222,227,247,63,141,261,249,123,139,105,75,242,163,162,188,26,214,77,17,82,289,98,194,109,111,98,64,63,127,185,72,206,177,181,23,13,46,74,120,175,86,251,270,158,116,0,75,49,194,295,93,72,264,39,171,182,183,208,255,29,118,247,80,204,119,251,130,251,65,220,270,65,295,290,262,157,195,137,47,193,184,257,110,15,152,16,112,135,89,291,3,195,184,160,8,215,94,295,87,109,96,106,70,178,211,80,173,173,298,280,75,243,231,122,189,148,150,40,291,53,177,205,32,195,222,234,129,24,150,172,17,124,35,43,94,298,181,82,125,141,19,137,131,284,82,52,152,103,154,119,78,20,192,109,164,265,127,178,114,17,32,43,43,228,79,41,12,208,254,155,240,296,157,20,188,99,83 4,50,49,153,122,31,83,193,255,149,56,269,112,97,232,65,134,71,264,183,112,117,259,176,280,155,99,261,77,78,53,104,0,223,253,83,211,121,244,223,131,23,123,102,213,93,240,45,178,287,73,282,34,296,190,180,271,173,73,258,22,132,228,73,113,119,158,81,174,63,23,269,33,196,271,69,285,254,132,148,231,251,115,58,98,124,45,186,29,61,208,151,55,298,141,1,128,86,226,268,247,53,32,3,45,113,56,294,262,175,219,43,77,8,249,235,238,100,135,167,241,169,61,62,109,172,103,158,128,172,15,164,62,289,280,298,252,123,242,297,77,52,209,5,102,208,33,33,87,120,168,93,88,243,93,113,120,253,123,218,198,122,286,194,155,67,175,225,137,272,85,200,267,84,110,4,88,296,229,174,182,80,152,238,258,28,163,125,22,135,210,150,122,284,296,178,160,185,26,55,85,5,45,126,165,168,235,12,122,17,93,181,155,179,99,273,231,173,129,220,49,17,73,228,286,103,205,238,10,239,145,62,181,273,284,196,4,199,290,2,287,22,88,175,243,12,16,169,94,124,153,220,135,97,22,123,172,229,174,196,243,125,239,217,208,219,57,232,21,74,286,246,66,55,71,278,77,77,215,200,232 209,294,73,160,32,300,203,4,173,30,31,240,85,13,89,114,90,285,294,120,83,48,49,194,123,124,214,98,190,62,55,175,24,137,272,78,236,114,87,276,190,188,128,29,168,209,275,251,6,163,275,129,204,151,154,139,106,121,81,16,73,294,18,117,109,147,46,142,77,189,163,47,282,197,152,117,32,235,138,226,179,250,5,63,22,31,99,38,0,161,197,163,249,24,57,204,136,107,45,212,279,159,26,228,120,139,148,62,99,28,177,51,279,29,133,82,262,225,82,202,77,27,9,97,237,89,70,144,76,102,13,145,62,260,177,227,279,99,163,24,190,123,289,34,277,186,104,44,144,66,299,39,8,103,164,277,162,122,255,248,202,217,300,102,149,124,209,53,127,163,245,162,128,153,68,186,147,204,266,111,91,88,45,159,67,175,109,263,143,57,205,224,184,235,48,243,60,287,19,18,238,114,139,35,34,52,14,215,160,168,65,140,224,226,120,271,224,26,191,214,4,129,120,82,296,241,209,125,221,83,107,130,284,36,194,104,31,55,23,130,288,163,148,292,65,114,119,84,151,41,155,290,167,273,197,132,208,19,227,210,149,46,67,98,236,15,155,227,241,97,292,242,203,272,263,125,37,287,239,209,120 Using a dictionary to handle the dupes, using this code Sub PickSample(intSampleSize As Integer, intPicks As Integer) Dim dicPicked As New Scripting.Dictionary Dim arr() As String Dim intCounter As Integer Dim intPicked As Integer ReDim arr(intPicks) For intCounter = 0 To UBound(arr) RetryPick: intPicked = CStr(Int((intSampleSize - (i - 1)) * Rnd + 1) + (i - 1)) If dicPicked.Exists(CStr(intPicked)) Then GoTo RetryPick Else dicPicked.Add CStr(intPicked), 1 arr(intCounter) = intPicked End If Next intCounter Debug.Print Join(arr(), ",") dicPicked.RemoveAll Set dicPicked = Nothing End Sub Gives results, hopefully dupe free PickSample 300,280 203,125,69,114,26,208,39,219,36,174,220,113,24,74,104,282,128,112,223,205,200,147,44,143,152,162,157,300,70,54,108,177,13,276,153,91,7,168,89,145,127,12,16,257,187,229,61,213,117,214,254,171,59,242,23,51,224,52,185,165,193,189,21,296,63,173,160,280,190,232,235,141,256,56,87,98,32,5,267,195,77,120,197,82,288,68,57,136,132,182,122,15,47,48,261,96,110,258,49,105,155,86,186,97,225,80,264,140,11,46,199,230,275,19,34,83,222,66,116,294,298,259,292,271,272,84,115,101,124,43,183,71,289,291,25,188,55,158,150,216,243,92,58,0,290,148,255,149,250,167,27,233,228,265,9,299,65,283,62,88,207,240,109,179,161,178,268,278,175,139,237,234,169,297,269,281,184,262,270,164,202,279,253,295,196,212,8,274,159,75,172,163,130,38,154,73,99,247,249,263,273,67,40,20,221,138,14,33,218,286,227,251,94,166,209,156,211,37,137,90,131,111,107,2,215,85,146,100,293,204,231,285,79,53,126,60,239,260,248,78,4,217,29,64,121,226,201,210,45,206,134,17,1,192,246,3,35,191,236,93,28,41,244,287,129,277,142,118,6,81,18,135,181,241,180,103,50,252,31,95,30 44,278,132,10,232,56,146,193,284,276,236,155,79,117,102,61,119,200,229,131,138,133,235,173,204,34,7,98,3,202,167,143,130,30,126,206,13,262,221,166,174,298,111,116,39,288,263,76,47,170,89,268,154,253,52,91,217,148,12,22,83,33,77,264,85,214,55,127,279,251,101,86,230,35,172,59,198,62,286,296,220,29,191,242,271,5,54,84,297,158,38,270,231,107,95,110,57,129,9,273,53,269,68,4,234,228,211,207,70,153,151,194,179,128,169,63,142,109,145,58,186,24,245,60,87,0,17,246,225,222,218,184,258,26,161,226,247,31,144,178,223,122,88,124,137,210,293,94,99,213,190,281,80,72,104,40,6,123,290,259,254,45,78,66,227,289,261,141,65,135,8,274,69,257,203,168,196,42,248,67,73,125,37,11,287,181,92,291,238,108,212,1,118,28,216,244,164,249,240,150,46,74,277,36,189,188,255,224,195,260,15,175,267,280,49,180,27,165,50,113,243,201,237,149,205,156,199,292,136,48,71,75,285,41,81,239,209,185,266,160,176,152,171,163,100,2,32,183,16,97,19,294,187,20,282,272,157,182,121,140,106,112,265,295,51,21,256,64,241,114,162,90,252,115,25,82,103,23,299,120,197 57,241,105,1,247,289,284,72,89,68,101,225,295,242,290,5,291,217,267,87,62,80,24,106,103,38,285,197,286,300,151,222,219,254,201,113,195,245,243,15,179,98,145,192,74,118,142,109,70,58,11,4,154,277,129,115,250,202,293,163,181,168,288,268,281,112,79,49,60,175,236,23,266,186,59,167,190,187,41,228,174,157,48,231,165,253,227,171,66,176,135,238,120,258,19,110,194,164,131,296,91,206,159,255,8,189,124,148,114,13,75,121,95,272,119,214,50,117,279,213,205,133,96,196,137,173,246,218,233,77,27,264,141,184,193,263,102,83,244,210,78,127,36,63,188,42,0,152,198,271,169,298,207,111,3,158,182,282,30,226,199,17,273,297,191,166,46,144,252,55,25,26,200,86,162,237,211,299,212,287,161,12,40,45,69,216,54,125,71,47,132,93,22,20,76,126,51,262,107,229,234,257,2,39,278,235,84,37,280,208,153,251,67,136,104,28,221,149,248,276,170,140,14,269,180,16,108,34,94,43,92,52,204,65,134,85,183,7,146,143,97,270,64,259,139,160,260,223,32,81,177,33,178,185,90,292,9,232,209,265,10,88,283,147,123,99,261,240,6,138,274,122,61,203,249,155,256,44,294,116,35
this function picks nItemsToPick random elements up from arr array and returns them into an array: Function PickNRandomElementsFromArray(arr As Variant, nItemsToPick As Long) As Variant Dim arrSize As Long Dim i As Long, iPick As Long Dim temp As String arrSize = UBound(arr) '<--| count the values as the array size If nItemsToPick > arrSize Then nItemsToPick = arrSize '<--| the items to be picked cannot exceed array size For i = 1 To nItemsToPick iPick = Int((arrSize - (i - 1)) * Rnd + 1) + (i - 1) '<--| pick a random number between 'i' and 'arrSize' ' swap array elements in slots 'i' and 'iPick' temp = arr(iPick) arr(iPick) = arr(i) arr(i) = temp Next i ReDim Preserve arr(1 To nItemsToPick) '<--| resize the array to first picked items PickNRandomElementsFromArray = arr '<--| return the array End Function which you can exploit as follows: Option Explicit Sub Authors() Dim Authors As Variant, AuthorsList As Variant With ThisWorkbook.Worksheets("Sheet") '<--| reference your relevant worksheet Authors = Application.Transpose(.Range("A2", .Cells(.rows.count, 1).End(xlUp)).Value) '<--| fill 'Authors' array with its column "A" values from row 2 down to its last not empty one AuthorsList = PickNRandomElementsFromArray(Authors, 280) '<--| fill 'AuthorsList' array with a selection of 280 random elements of 'Authors' .Range("B1").Value = Join(AuthorsList, " OR ") '<--| fill cell "B1" with a string build by concatenating 'AuthorsList' values delimited with " OR " End With End Sub that can be quite contracted (and made as much less readable) to: Sub Authors() With ThisWorkbook.Worksheets("Sheet") '<--| reference your relevant worksheet .Range("B1").Value = Join(PickNRandomElementsFromArray(Application.Transpose(.Range("A2", .Cells(.rows.count, 1).End(xlUp)).Value), 280), " OR ") End With End Sub
From your comments, you seem to want to concatenate the array of strings, then put it back into excel. This, put just before the End Sub, will put it into cell B1 for example: ThisWorkbook.Worksheets("Sheet1").Range("B1").Value = Join(Authorlist, "OR")
type mismatch assigning range to 1d array
I've got a range in a text format containing values and numbers. I am trying to assign the numbers only to an array and then I will assign the text values to another array without having to loop through the range. However, this code says - type mismatch? Sub Igra() Dim Arr() As Variant 'convert the range values from text to general Sheets("Sheet1").Range("R32:W32").NumberFormat = "General" Sheets("Sheet1").Range("R32:W32").Value = Sheets("Sheet1").Range("R32:W32").Value ' assign only the numbers to the array Arr = Sheets("Sheet1").Range("R32:W32").SpecialCells(xlCellTypeConstants, xlNumbers).Value End Sub This should work then Dim Arr() As Variant Sheets("Sheet1").Range("R32:W32").SpecialCells(xlCellTypeConstants, xlNumbers).Copy Sheets("Sheet1").Range("A1").PasteSpecial xlValues Arr = Range(Range("A1"), Range("A1").End(xlToRight)) Dim R As Long Dim C As Long For R = 1 To UBound(Arr, 1) ' First array dimension is rows. For C = 1 To UBound(Arr, 2) ' Second array dimension is columns. MsgBox Arr(R, C) Next C Next R
Try this Sub Sample() Dim ws As Worksheet Dim Arr() As Variant Dim rng As Range, cl As Range Dim n As Long, i As Long Set ws = ThisWorkbook.Sheets("Sheet1") Set rng = ws.Range("R32:W32") n = Application.WorksheetFunction.Count(rng) If n = 0 Then Exit Sub ReDim Arr(1 To n) i = 1 For Each cl In rng If IsNumeric(cl.Value) Then Arr(i) = cl.Value i = i + 1 End If Next cl '~~> Only for demonstration purpose For i = 1 To n Debug.Print Arr(i) Next i End Sub
Excel VBA function to print an array to the workbook
I've written a macro that takes a 2 dimensional array, and "prints" it to equivalent cells in an excel workbook. Is there a more elegant way to do this? Sub PrintArray(Data, SheetName, StartRow, StartCol) Dim Row As Integer Dim Col As Integer Row = StartRow For i = LBound(Data, 1) To UBound(Data, 1) Col = StartCol For j = LBound(Data, 2) To UBound(Data, 2) Sheets(SheetName).Cells(Row, Col).Value = Data(i, j) Col = Col + 1 Next j Row = Row + 1 Next i End Sub Sub Test() Dim MyArray(1 To 3, 1 To 3) MyArray(1, 1) = 24 MyArray(1, 2) = 21 MyArray(1, 3) = 253674 MyArray(2, 1) = "3/11/1999" MyArray(2, 2) = 6.777777777 MyArray(2, 3) = "Test" MyArray(3, 1) = 1345 MyArray(3, 2) = 42456 MyArray(3, 3) = 60 PrintArray MyArray, "Sheet1", 1, 1 End Sub
On the same theme as other answers, keeping it simple Sub PrintArray(Data As Variant, Cl As Range) Cl.Resize(UBound(Data, 1), UBound(Data, 2)) = Data End Sub Sub Test() Dim MyArray() As Variant ReDim MyArray(1 To 3, 1 To 3) ' make it flexible ' Fill array ' ... PrintArray MyArray, ActiveWorkbook.Worksheets("Sheet1").[A1] End Sub
Create a variant array (easiest by reading equivalent range in to a variant variable). Then fill the array, and assign the array directly to the range. Dim myArray As Variant myArray = Range("blahblah") Range("bingbing") = myArray The variant array will end up as a 2-D matrix.
A more elegant way is to assign the whole array at once: Sub PrintArray(Data, SheetName, StartRow, StartCol) Dim Rng As Range With Sheets(SheetName) Set Rng = .Range(.Cells(StartRow, StartCol), _ .Cells(UBound(Data, 1) - LBound(Data, 1) + StartRow, _ UBound(Data, 2) - LBound(Data, 2) + StartCol)) End With Rng.Value2 = Data End Sub But watch out: it only works up to a size of about 8,000 cells. Then Excel throws a strange error. The maximum size isn't fixed and differs very much from Excel installation to Excel installation.
As others have suggested, you can directly write a 2-dimensional array into a Range on sheet, however if your array is single-dimensional then you have two options: Convert your 1D array into a 2D array first, then print it on sheet (as a Range). Convert your 1D array into a string and print it in a single cell (as a String). Here is an example depicting both options: Sub PrintArrayIn1Cell(myArr As Variant, cell As Range) cell = Join(myArr, ",") End Sub Sub PrintArrayAsRange(myArr As Variant, cell As Range) cell.Resize(UBound(myArr, 1), UBound(myArr, 2)) = myArr End Sub Sub TestPrintArrayIntoSheet() '2dArrayToSheet Dim arr As Variant arr = Split("a b c", " ") 'Printing in ONE-CELL: To print all array-elements as a single string separated by comma (a,b,c): PrintArrayIn1Cell arr, [A1] 'Printing in SEPARATE-CELLS: To print array-elements in separate cells: Dim arr2D As Variant arr2D = Application.WorksheetFunction.Transpose(arr) 'convert a 1D array into 2D array PrintArrayAsRange arr2D, Range("B1:B3") End Sub Note: Transpose will render column-by-column output, to get row-by-row output transpose it again - hope that makes sense. HTH
My tested version Sub PrintArray(RowPrint, ColPrint, ArrayName, WorkSheetName) Sheets(WorkSheetName).Range(Cells(RowPrint, ColPrint), _ Cells(RowPrint + UBound(ArrayName, 2) - 1, _ ColPrint + UBound(ArrayName, 1) - 1)) = _ WorksheetFunction.Transpose(ArrayName) End Sub
You can define a Range, the size of your array and use it's value property: Sub PrintArray(Data, SheetName As String, intStartRow As Integer, intStartCol As Integer) Dim oWorksheet As Worksheet Dim rngCopyTo As Range Set oWorksheet = ActiveWorkbook.Worksheets(SheetName) ' size of array Dim intEndRow As Integer Dim intEndCol As Integer intEndRow = UBound(Data, 1) intEndCol = UBound(Data, 2) Set rngCopyTo = oWorksheet.Range(oWorksheet.Cells(intStartRow, intStartCol), oWorksheet.Cells(intEndRow, intEndCol)) rngCopyTo.Value = Data End Sub