Export array values to Excel

[gmaxey]

Hi,

I'm trying to write the values of a single dimension array to a new Excel worksheet:


Sub Problem()
Dim arrTest() As String
arrTest = Split("A|B|C|D", "|")
WriteToExcel arrTest
End Sub
Sub WriteToExcel(ByVal arrPassed)
Dim o As Object
Set o = CreateObject("excel.application")
o.Visible = True
o.Workbooks.Add
o.sheets("sheet1").Range("A1:A" & UBound(arrPassed) + 1).Value = arrPassed
End Sub


The result I get is "A" in each cell. How do I revise this code so that "A" is in Cell A1, "B" is in Cell A2, etc.

Is there a better way to write an array to Excel? Thanks.

[JKwan]

try this, don't know if it is the best way:


Sub Problem()
Dim arrTest() As String
arrTest = Split("A|B|C|D", "|")
WriteToExcel arrTest
End Sub
Sub WriteToExcel(ByVal arrPassed)
Dim o As Object
Dim Destination As Range

Set o = CreateObject("excel.application")
o.Visible = True
o.Workbooks.Add
Set Destination = o.Sheets("sheet1").Range("A1")
Set Destination = Destination.Resize(UBound(arrPassed) + 1, 1)
Destination.Value = Application.Transpose(arrPassed)

Set Destination = Nothing
Set o = Nothing
End Sub

[Kenneth Hobs]

Sub WriteToExcel(ByVal arrPassed)
Dim o As Object
Set o = CreateObject("excel.application")
With o
.Visible = True
.Workbooks.Add
.sheets("sheet1").Range("A1").Resize(UBound(arrPassed) + 1).Value = .Transpose(arrPassed)
End With
End Sub

[gmaxey]

JKwan, Thanks for your time and post. Kenneth's was less code and works.

[gmaxey]

Kenneth,

Thanks! That works great. Here I am with my hand out again though. I suppose my initial question was too simplistic. What if I have a multi-demensional array and need to write each array element to a row:


Sub ProblemNew()
Dim arrTest(3, 1)
arrTest(0, 0) = "A"
arrTest(0, 1) = "Apple"
arrTest(1, 0) = "B"
arrTest(1, 1) = "Blueberry"
arrTest(2, 0) = "C"
arrTest(2, 1) = "Cherry"
arrTest(3, 0) = "DA"
arrTest(3, 1) = "Dill pickle"
WriteToExcel arrTest
End Sub
Sub WriteToExcel(ByVal arrPassed)
Dim o As Object
Set o = CreateObject("excel.application")
With o
.Visible = True
.Workbooks.Add
.sheets("sheet1").Range("A1").Resize(UBound(arrPassed) + 1).Value = .Transpose(arrPassed)
End With
End Sub


Thanks again.

[JKwan]

try this, once again may not be the best


Sub ProblemNew()
Dim arrTest(3, 1)
arrTest(0, 0) = "A"
arrTest(0, 1) = "Apple"
arrTest(1, 0) = "B"
arrTest(1, 1) = "Blueberry"
arrTest(2, 0) = "C"
arrTest(2, 1) = "Cherry"
arrTest(3, 0) = "DA"
arrTest(3, 1) = "Dill pickle"
WriteToExcel arrTest
End Sub
Sub WriteToExcel(ByVal arrPassed)
Dim o As Object
Dim NumRows As Long
Dim NumCols As Long

NumRows = UBound(arrPassed, 1) - LBound(arrPassed, 1) + 1
NumCols = UBound(arrPassed, 2) - LBound(arrPassed, 2) + 1
Set o = CreateObject("excel.application")
With o
.Visible = True
.Workbooks.Add
.Sheets("sheet1").Range("A1").Resize(NumRows, NumCols).Value = arrPassed
End With
End Sub



By the way, if you want more info, read this
http://www.cpearson.com/excel/ArraysAndRanges.aspx

[Kenneth Hobs]

Similarly:

.sheets("sheet1").Range("A1").Resize(UBound(arrPassed, 1) + 1, UBound(arrPassed, 2) + 1).Value = arrPassed

[gmaxey]

Kenneth, JKwan

Thanks again to both of your for you time and assistance. To summarize the solutions I suppose I can do something like this:


Sub SolutionsDemonstrated()
Dim arrTest1() As String
Dim arrTest2(3, 1)
arrTest1 = Split("A|B|C|D", "|")
arrTest2(0, 0) = "A"
arrTest2(0, 1) = "Apple"
arrTest2(1, 0) = "B"
arrTest2(1, 1) = "Blueberry"
arrTest2(2, 0) = "C"
arrTest2(2, 1) = "Cherry"
arrTest2(3, 0) = "D"
arrTest2(3, 1) = "Dill pickle"
WriteToExcel arrTest1
WriteToExcel arrTest2
End Sub
Sub WriteToExcel(ByVal arrPassed)
Dim o As Object
Set o = CreateObject("excel.application")
With o
.Visible = True
.Workbooks.Add
Select Case fcnNumDemensions(arrPassed)
Case 1
.sheets("sheet1").Range("A1").Resize(UBound(arrPassed) + 1).Value = .Transpose(arrPassed)
Case 2
.sheets("sheet1").Range("A1").Resize(UBound(arrPassed, 1) + 1, UBound(arrPassed, 2) + 1).Value = arrPassed
Case Else
'Do nothing
End Select

End With
End Sub
Function fcnNumDemensions(ByRef arrEvaluate) As Long
Dim lngIndex As Long, lngCheck As Long
On Error GoTo Err_Return
For lngIndex = 1 To 60000 'Limit
'Is error generated? If so demension doesn't exist.
lngCheck = LBound(arrEvaluate, lngIndex)
Next lngIndex
lbl_Exit:
Exit Function
Err_Return:
fcnNumDemensions = lngIndex - 1
Resume lbl_Exit:
End Function

[Kenneth Hobs]

There are occasions where a double Transpose is needed for arrays. When this happens, an Index method is a bit more efficient and shorter in code length. I seldom need either.

Of course dealing with more than 3 dimensions is a bit hard to visualize. For your scenario, I would think that an On Error and using both would suffice. I would set an On Error GoTo 0 have the two lines that may error.

Here is a Microsoft reference showing code a bit similar to Greg's for determining the number of dimensions. http://support.microsoft.com/kb/152288

[Paul_Hossler]

Hi Greg, slight variantion the theme

I assume that you're having Word write the array to Excel??
Is that why you passed the array ByVal and not ByRef?

I added IsArray() and used the LBound(s) and UBounds(s) to .Resize the range just in case sometimes the Base is not 0



Sub MyWriteToExcel(ByVal arrPassed As Variant)
Dim iNumDims As Long
Dim x As Long


If Not IsArray(arrPassed) Then Exit Sub

iNumDims = 3

On Error GoTo FindNumDims
x = LBound(arrPassed, iNumDims)

Select Case iNumDims
Case 1
ActiveSheet.Cells(1, 1).Resize(1, UBound(arrPassed) - LBound(arrPassed) + 1).Value = arrPassed

Case 2
ActiveSheet.Cells(1, 1).Resize(UBound(arrPassed, 1) - LBound(arrPassed, 1) + 1, UBound(arrPassed, 2) - LBound(arrPassed, 2) + 1).Value = arrPassed
Case Else
MsgBox "More than 2 Dim"

End Select


Exit Sub

FindNumDims:
iNumDims = iNumDims - 1
Resume
End Sub



Paul

[gmaxey]

Paul,

Thanks. All good nuggets to know. I really don't know why I passed it ByVal, but yes they were passed from Word.