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