Importing data into Excel

Question

Is there an easier way of importing data into an Excel array or other data structure? I've tried researching collections but I have found the documentation hard to comprehend.

MSDN

The code I have opens a select file and searches for the column header and then loops through each row storing the data according to header and row variables. I've done this method for many macros in the past but now I am dealing with many many columns and I'm looking for a more advanced way.

Sub Import_NAVRec()

MyPath = Range("b2")                                'Defines cell that contains path to source file
Workbooks.Open (MyPath)                             'Opens file
Set tempbook = ActiveWorkbook                       'Names workbook
LR = Range("A65000").End(xlUp).Row                  'finds last row in sourcefile



ReDim aNavRec(1 To LR, 1 To 4)                      'Defines NAV Rec array
nRow = 0


 cName = "Accounting Basis"
 CA = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
 cName = "Accounting Date"
 cB = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
 cName = "Asset Currency"
 cC = Cells.Find(What:=UCase(cName), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column

     For r = 2 To LR
        'If Cells(r, cB) = "Trading Gain Loss" Then
         nRow = nRow + 1
         aNavRec(nRow, 1) = Cells(r, CA) 'Fund Number
         aNavRec(nRow, 2) = Cells(r, cB) 'Ledger
         aNavRec(nRow, 3) = Cells(r, cC) 'Balance change
        'End If

     Next r


tempbook.Close
End Sub

Sub Print_output()

Sheets("Output").Select
Set Destination = Range("a2")
Destination.Resize(UBound(aNavRec, 1) + 1, UBound(aNavRec, 2)).Value = aNavRec


End Sub

Answer 1

I propose the following refactoring based on:

• use of arrays to range and viceversa

  though tempered by the fact that you have to deal with possible non contiguous columns range

• use of fully qualified range references

  to both avoid Select/Activate stuff and have full control of which range/worksheet/workbook you're dealing with

• use of Option Explicit statement

  to force explicit declaration of type for ALL variables used in the code

  this extra work earns you back with a lot more control of what you're actually doing and saves you a lot of time in both code debugging and maintenance

• robust function to return a "valid" workbook

  see GetWorkBook() function

`

Option Explicit

Sub Import_NAVRec()
    Dim tempbook As Workbook
    Dim LR As Long, LC As Long, c As Long, nCols As Long
    Dim aNavRec() As Variant                            'declare NAV Rec array. it'll be an array of arrays
    Dim headers As String                               'declare the variable where you'll put headers of interest

    Set tempbook = GetWorkBook(ActiveSheet.Range("b2")) 'try setting a workbook whose path is in cell "B2" of ActiveSheet

    If tempbook Is Nothing Then Exit Sub                'exit sub if no valid workbook is returned

    headers = "|Accounting Basis|Accounting Date|Asset Currency|"   ' set your headers delimited by a "|"
    ReDim aNavRec(1 To UBound(Split(headers, "|")) - 1)             ' dim aNavRec to number of headers you want to grab columns of
    With tempbook.ActiveSheet
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row                 'find last row in sourcefile column A
        LC = .Cells(1, .Columns.Count).End(xlToLeft).Column         'find last column in sourcefile headers

        For c = 1 To LC 'loop through every column
            If InStr(headers, "|" & .Cells(1, c) & "|") <> 0 Then   'if current column header is bewteen the wanted ones
                nCols = nCols + 1                                   'update the number of found columns
                aNavRec(nCols) = Application.Transpose(.Range(.Cells(1, c), .Cells(LR, c))) 'store the found column in the variant element in the current index (nCols) of the array. you have to transpose a "column" range to fit into a "horizontal" variant array
            End If
        Next c
        ReDim Preserve aNavRec(1 To nCols)              ' redim aNavRec to actual number of headers found nt to grab columns of
    End With
    tempbook.Close (False)

    Print_output Worksheets("Output").Range("a2"), aNavRec 'after closing 'tempbook' the active workbook (and worksheet) is the one we started with

End Sub

Sub Print_output(iniRng As Range, arrays() As Variant)
    Dim i As Long
    With iniRng
        For i = 1 To UBound(arrays)
            iniRng.Offset(, i - 1).Resize(UBound(arrays) + 1).Value = Application.Transpose(arrays(i)) ' you have to transpose back the array to fit it into a "column" range
        Next i
        .CurrentRegion.EntireColumn.AutoFit
    End With
End Sub

Function GetWorkBook(path As String) As Workbook
    ' returns the workbook corresponding to path
    ' checks whether a workbook with the given name and path is already open
    ' if an already open workbook has the same name but different path:
    ' -  if it is NOT the active one -> it'llbe closed and the requested one will be opened
    ' -  if it IS the active one -> no action will be taken
    '
    ' requires reference to "Microsoft Scripting RuntTime" library

    Dim fso As New FileSystemObject
    Dim f As File
    Dim fName As String

    If Not fso.GetExtensionName(path) Like "xls*" Then Exit Function 'exit if it's not a valid excel file

    If Not fso.FileExists(path) Then Exit Function 'exit if there's no such file

    Set f = fso.GetFile(path) 'get the file corresponding to the now validated path

    fName = fso.GetFileName(path)

    Set GetWorkBook = TrySetWorkbook(fName) 'check whether that workbook is already open
    If GetWorkBook Is Nothing Then 'if no...
        Set GetWorkBook = Workbooks.Open(path) '... open it!
    Else 'if yes...
        If GetWorkBook.FullName <> f.path Then '... and it has a different path from the requested workbook one ...
            ' ... then you should close the already open workbook with the same of the requested one before opening this latter
            If ActiveSheet.Parent.name = fName Then 'if the workbook to close is the active one (!)...
                MsgBox "workbook:" & vbCrLf & vbCrLf & "'" & ActiveSheet.Parent.FullName & "'" _
                       & vbCrLf & vbCrLf & "should be closed to open woorkbook:" & vbCrLf & vbCrLf & "'" & f.path _
                       & vbCrLf & vbCrLf & vbCrLf & "but the former is the active workbook, so no action will be taken", vbInformation
                Set GetWorkBook = Nothing ' set the return workbook to Nothing so as to have calling sub skip the passed path
            Else 'otherwise...
                Workbooks(fName).Close True '... close (saving changes) the already open one...
                Set GetWorkBook = Workbooks.Open(path) '<~~ ... and finally open the requested one
            End If
        End If
    End If

End Function

Function TrySetWorkbook(path As String) As Workbook
    On Error Resume Next
    Set TrySetWorkbook = Workbooks(path)
End Function

Answer 2

If you are after spreadsheet data, then you can just import a range into an array. Like so:

Public Sub GetSheetData()

    Dim sheetRange As Range
    Set sheetRange = GetSheetRange

    Dim sheetData As Variant
    sheetData = Array()
    sheetData = sheetRange
    '/ And now whatever was in the top left cell of your sheet 
    '/ Range is in sheetData(1, 1), next row (2, 1) etc.

End Sub

Public Function GetSheetRange() As Range

    Dim headerCell As Range
    Set headerCell = Cells.Find(... '/ Your find criteria here

    Dim firstRow As Long
    firstRow = headerCell.Row

    Dim firstColumn As Long
    firstColumn = headerCell.Column

    Dim lastRow As Long
    lastRow = Cells(Rows.Count, firstColumn).End(xlUp).Row

    Dim lastColumn As Long
    lastColumn = headerCell.Column

    Set GetSheetRange = Range(Cells(firstRow, firstColumn), Cells(lastRow, lastColumn))

End Function

You could also just import the entire sheet into an array and then search the array for your headers. Or whatever else will suit. The above is just a demonstration of syntax.

Also, please make note of the naming, indenting and spacing. Code should be written to be read by other people. Give things descriptive names. Use indentation. Space separate concerns apart from each other.