VB and VBA Users Source Code: Exporting data to Excel and outputing an array to a Range
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Exporting data to Excel and outputing an array to a Range
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, February 23, 2001
Hits:
1609
Category:
Unspecified
Article:
The following routine demonstrate how to export data to Excel and write arrays to a range. A demonstration routine can be found at the bottom of this post. Note, all the routines use late binding to remove the need for references when using VB. Option Explicit 'Purpose : Write a 1d or 2d array to a worksheet in an Excel workbook. 'Inputs : avValues A 1d or 2d array of the values to write to the worksheet. ' sWorkbookPath The path of the workbook to store the data in. ' If the workbook exists, opens the workbook and adds a new sheet ' to the workbook. ' [sSheetName] The name of the worksheet to place the data in. 'Outputs : Returns True if successful 'Author : Andrew Baker 'Date : 31/12/2000 13:51 'Notes : 'Revisions : Function ExportToExcel(avValues As Variant, sWorkbookPath As String, Optional sSheetName As String = "") As Boolean Dim oExcel As Object Dim oWorkbook As Object On Error Resume Next Set oExcel = CreateObject("Excel.Application") If (oExcel Is Nothing) = False Then On Error GoTo ErrFailed 'Successfully created an Excel Application If Len(Dir$(sWorkbookPath)) > 0 Then 'Workbook exists, open it Set oWorkbook = oExcel.Workbooks.Open(sWorkbookPath) 'Add sheet to store results oWorkbook.Sheets.Add oWorkbook.Sheets(1) Else 'Workbook doesn't exist, create new workbook Set oWorkbook = oExcel.Workbooks.Add End If If Len(sSheetName) Then 'Set the worksheet name oWorkbook.Sheets(1).Name = sSheetName End If 'Export array to worksheet ArrayToRange oWorkbook.Sheets(1).range("A1"), avValues, False, False If Len(Dir$(sWorkbookPath)) > 0 Then 'Save existing workbook oWorkbook.Save Else 'Save new workbook oWorkbook.SaveAs sWorkbookPath End If 'Close Excel oWorkbook.Close False oExcel.Quit Set oExcel = Nothing 'Return success ExportToExcel = True End If Exit Function ErrFailed: Debug.Assert False Debug.Print err.description ExportToExcel = False On Error GoTo 0 End Function 'Purpose : Write an 1d or 2d array to a range on an Excel sheet. 'Inputs : rngOutput The top left cell in the range to write the array to e.g. Range("A1") ' avValues An array of the values to write to the above range. ' [bTranspose] If true will transpose the result i.e. columns and rows will swap positions. ' [bStoreDatesAsLong] If True will convert an dates in the array to longs. This ' prevents date conversion problems when reading the information ' back from the range. 'Outputs : Returns the error number if an error occurs 'Author : Andrew Baker 'Date : 31/12/2000 13:51 'Notes : 'Revisions : Function ArrayToRange(rngOutput As Object, avValues As Variant, Optional bTranspose As Boolean = False, Optional bStoreDatesAsLong As Boolean = False) As Long Dim lThisRow As Long, lThisCol As Long Dim lLastRow As Long, lLastCol As Long Dim lNumRows As Long, lNumCols As Long Dim lFirstRow As Long, lFirstCol As Long Dim lNumDims As Long, avTmpArray As Variant On Error GoTo ErrFailed If IsArray(avValues) Then lFirstRow = LBound(avValues) lLastRow = UBound(avValues) lNumDims = ArrayNumDimensions(avValues) Select Case lNumDims Case 1 'Resize 1d to a 2d array ReDim avTmpArray(lFirstRow To lLastRow, 1 To 1) For lThisRow = lFirstRow To lLastRow avTmpArray(lThisRow, 1) = avValues(lThisRow) Next Case 2 'Copy 2d array avTmpArray = avValues Case Else Debug.Print "Invalid array dimension" Debug.Assert False ArrayToRange = 1 'Failed End Select lFirstCol = LBound(avTmpArray, 2) lLastCol = UBound(avTmpArray, 2) lNumRows = lLastRow - lFirstRow + 1 lNumCols = lLastCol - lFirstCol + 1 If bStoreDatesAsLong Then 'Convert dates to longs For lThisRow = lFirstRow To lLastRow For lThisCol = lFirstCol To lLastCol If IsDate(avTmpArray(lThisRow, lThisCol)) Then avTmpArray(lThisRow, lThisCol) = CLng(CDate(avTmpArray(lThisRow, lThisCol))) End If Next Next End If If bTranspose Then 'Write array values to range transposing values With rngOutput .Parent.cells.NumberFormat = "@" 'Required to display values correctly .Parent.range(.cells(1), .cells(lNumCols, lNumRows)).Value = .Parent.Parent.Parent.WorksheetFunction.Transpose(avTmpArray) End With Else 'Write array values to range With rngOutput .Parent.cells.NumberFormat = "@" 'Required to display values correctly .Parent.range(.cells(1), .cells(lNumRows, lNumCols)).Value = avTmpArray End With End If End If ArrayToRange = 0 Exit Function ErrFailed: 'Return and clear error Debug.Assert False Debug.Print err.description ArrayToRange = err.number On Error GoTo 0 Exit Function Resume End Function 'Purpose : Calculates the number of dimensions in an array 'Inputs : avValues The array to determine the number of dimensions 'Outputs : The number of dimensions the array has. 'Author : Andrew Baker 'Date : 25/03/2000 'Notes : Function ArrayNumDimensions(avValues As Variant) As Long Dim lNumDims As Long If IsArray(avValues) Then On Error GoTo ExitSub Do lNumDims = UBound(avValues, ArrayNumDimensions + 1) ArrayNumDimensions = ArrayNumDimensions + 1 Loop End If ExitSub: On Error GoTo 0 End Function 'Demonstration routine. 'This routine demonstrates two techniques for exporting data to a workbook/range: 'Method 1: This must be used in Excel or an application that references 'the Excel object library. 'Method 2: Creates an instance of Excel, creates a new workbook and saves it to the specified path. This is more appropriate for VB programmers. Sub Test() Dim asValues(1 To 50, 1 To 5) As String, lThisCol As Long, lThisRow As Long 'Create some made up data For lThisRow = 1 To 50 For lThisCol = 1 To 5 asValues(lThisRow, lThisCol) = "ROW " & lThisCol & " COL " & lThisRow Next Next 'Method 1 'Use this routine to output data to an open worksheet. You will need a reference to an existing instance of Excel to use this (can be used directly in Excel VBA) ArrayToRange ActiveSheet.Range("A1"), asValues, False, True 'Method 2 'Use this routine to export data to an Excel workbook (can be used from VB without referencing Excel) ExportToExcel asValues, "C:\Test.xls" End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
