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

---