Import Data from Excel to VBA

I’ve always wanted a function that can get me data from excel in a format that will always be the same. Sometimes I get the data and I expect a 2D variant array but instead get a string or double value. So I created a function to make it easy for myself, getting the same format that I expect.

'ImportExcelData
' --------------------------------------------------------------
'Comments:  This Function imports excel data in different formats (1D, 2D, or String).
'
'Arguments: rRng  Range to be imported.
'           i1D_2D_Str3 Type of import, 1=1D, 2=2D, and 3=String
'           iValueType  Import type .Value (Excel checks for different types)
'                       or .Value2 (Excel retrieves all values as string or double)
'           sDelimiter  Delimiter to use for string value that is returned.
'
'Notes:     This was created for use of Jon Nyman and can be distributed by Paciolan.
'Date           Developer   History
'--------------------------------------------------------------
'Dec 30, 2011   Jon Nyman   Initial version     www.SpreadsheetBudget.com
'
Public Function ImportExcelData(ByRef rRng As Range, Optional ByVal i1D_2D_Str3 As Integer = 2 _
        , Optional iValueType As Integer = 2, Optional ByVal sDelimiter As String = "`") As Variant

    Dim i As Long, j As Long
    Dim saData() As String, sData As String
    Dim vaData(1 To 1, 1 To 1) As Variant, va1D() As Variant
    Dim vData As Variant
    
    'Get data by Value or Value2
    If iValueType = 2 Then
        vData = rRng.Value2
    Else
        vData = rRng
    End If
    'If data is single cell then put in 2D
    If rRng.Cells.Count = 1 Then
        vaData(1, 1) = vData
        vData = vaData
    End If
    
    If i1D_2D_Str3 = 2 Then
        'Return 2D results
        ImportExcelData = vData
    ElseIf i1D_2D_Str3 = 3 Then
        'Concatenate 2D results and return string.
        If rRng.Columns.Count > 1 Then
            sData = vbNullString
            ReDim saData(1 To UBound(vData, 2))
            For i = 1 To UBound(vData)
                For j = 1 To UBound(vData, 2)
                    saData(j) = CStr(vData(i, j))
                Next j
                sData = sData & Join(saData, sDelimiter) & vbNewLine
            Next i
            ImportExcelData = Left$(sData, Len(sData) - 1)
        Else
            'Concatenate 1D results and return string
            ReDim saData(1 To UBound(vData))
            For i = 1 To UBound(vData)
                saData(i) = vData(i, 1)
            Next i
            ImportExcelData = Join(saData, sDelimiter)
        End If
    Else
        'Dimension 1D result variant array.
        ReDim va1D(1 To UBound(vData) * UBound(vData, 2))
        'Create 1D out of 2D
        If rRng.Columns.Count > 1 Then
            For i = 1 To UBound(vData)
                For j = 1 To UBound(vData, 2)
                    va1D((i - 1) * UBound(vData, 2) + j) = vData(i, j)
                Next j
            Next i
        Else
            For i = 1 To UBound(vData)
                va1D(i) = vData(i, 1)
            Next i
        End If
        ImportExcelData = va1D
    End If
  
End Function

Wed Jan 4, 2012 | tags: vba excel code

comments powered by Disqus