Excel worksheet data to a PowerPoint array (part of a tutorial by Brian Reilly and Naresh Nichani)
This subroutine pulls data from the Excel file (and worksheet within the file) that the user has chosen in the main form. In addition, It grabs data only from the fields the user has selected.
The example code here won't work on its own. It's based on several assumptions:
1) Other modules have enabled the user to select an XLS file, select a worksheet within the file and choose which columns/fields to pull data from, and further that the chosen XLS file has been opened and suitable references created to it in the variables declared below.
2) You've set a reference to the Microsoft Excel 11.0 Object Library
3) It assumes the following variables dimensioned in the Declarations section of the code module (already done for you in the example file)
The example file takes care of all of these requirements.
Private wb As Excel.Workbook Private wkCurrentSht As Excel.Worksheet Private ExcelApp As Excel.Application Private ExcelOpened As Boolean ' string arrays Private arrCols() As String Dim arrData() As String
Private Sub CreateArrayFromExcel() ' Populates array arrData from selected Excel data ' Called by cmdFinish_Click() (click event handler for Finish button on form) Dim strField As String Dim x As Long Dim y As Long Dim Num As Long Dim NumofColumn As Long Dim NumRows As Long Dim rng As Range On Error GoTo err_handler ExcelApp.DisplayAlerts = False ExcelApp.ScreenUpdating = False NumofColumn = 0 ReDim arrCols(0) ' initialize array to hold column names ' When user chose the XLS file and worksheet to use, we ' filled the listbox lstFields with the names of the columns (ie, fields) ' on the worksheet ' Add each selected column name as a new element in the arrray arrCols For x = 0 To lstFields.ListCount - 1 ' is the field selected in lstFields? If lstFields.Selected(x) Then ' get its name strField = Me.lstFields.Column(0, x) ' update our counter NumofColumn = NumofColumn + 1 ' add a new element to the array ReDim Preserve arrCols(UBound(arrCols) + 1) ' and store the column name in the array arrCols(UBound(arrCols)) = strField End If Next If NumofColumn > 25 Then MsgBox "Please select 25 columns or less", vbInformation Exit Sub End If ' get the requested number of rows of data (ie, records) ' and store it in the array arrData ' first, how many rows of data must we process? ' every row in the worksheet? If optAll.Value Then Set rng = wkCurrentSht.Range(txtRange.Text) NumRows = rng.Rows.Count Num = NumRows Else ' a specifc number of rows ' make sure that there really are that many rows ' if not, use what rows there are Set rng = wkCurrentSht.Range(txtRange.Text) NumRows = IIf(rng.Rows.Count > VBA.Val(txtNoofRows.Text), VBA.Val(txtNoofRows.Text), rng.Rows.Count) Num = NumRows End If ' NumRows now contains the number of rows to process ' dimension the array arrData to the needed number of rows and columns ReDim arrData(1 To NumRows, 1 To UBound(arrCols)) As String ' fill the data array with data from the worksheet For x = 1 To NumRows For y = 1 To UBound(arrCols) ' assumes data starts in second row after headers in first row ' so we offset by one arrData(x, y) = wkCurrentSht.Cells(x + 1, y).Value Next Next ' close the XLS workbook, don't save any changes wb.Close SaveChanges:=False ' release memory used by the workbook Set wb = Nothing ExcelApp.ScreenUpdating = True ' If we originally started Excel to do our bidding, close it ' If it was already open, leave it open If ExcelOpened Then If Not ExcelApp Is Nothing Then ExcelApp.Quit Set ExcelApp = Nothing End If End If ' Display the data we've pulled from Excel into the arry arrData ' You could do the same kind of thing with arrCols to display the field names For x = 1 To UBound(arrData, 1) For y = 1 To UBound(arrData, 2) Debug.Print arrData(x, y) Next Next Exit Sub err_handler: ExcelApp.ScreenUpdating = True MsgBox ("Error in CreateArrayFromExcel :" & Err.Description), vbInformation End Sub