CODEWITHSUNDEEP
excelvba
lsmetpitt
lsmetpitt

Reputation: 29

Dynamically Allocate CSV for Excel VBA

I am attempting to create a macro for Excel, in which the user may import a CSV. The size of the CSV will vary. There will always be 2 rows, but the number of columns will range from 50-500, or so. I am inexperienced with VBA, and am struggling to get past an error 9 - subscript out of range. I believe it is caused by the For loop with ReDim Preserve function. Since I am encountering this error, my next subroutine does not execute. The import subroutine is based on examples I found online (mainly this one - https://gist.github.com/gimbo/145d8527e7de823b7b537f4f34d216b3). I have tried using Lbound and Ubound but my csv file variable doesn't seem to be the correct type for these functions. I also contemplated using a For Each...Next loop instead, but wasn't able to get it working. At this point, I'm guessing the error is because I am incrementing "i" in the "i,j" array, and ReDim states that only "j" may be incremented while using Preserve. That said, switching these sections to attempt the fix confuses me and I couldn't get it to work that way either. I appreciate any suggestions.

Sub ImportCSV()
    Dim column_types() As Variant
    csv_path = Application.GetOpenFilename()
    For i = 0 To 16384
        ReDim Preserve column_types(i)
        column_types(i) = 2
    Next i
    With ActiveWorkbook.Sheets(1).QueryTables.Add(Connection:="TEXT;" & csv_path, Destination:=Range("A1"))
        .Name = "importCSVimporter"
        .FieldNames = True
        .AdjustColumnWidth = True
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = column_types
        .Refresh BackgroundQuery:=False
    End With
    ActiveWorkbook.Sheets(1).QueryTables("importCSVimporter").Delete
End Sub
Sub TransposeRawData()
    Dim ColNumber As Long
    Dim ColLetter As String
    Dim OldRange As String
    Dim NewRange As String
    ColNumber = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    ColLetter = Split(Cells(1, ColNumber).Address, "$")(1)
    Let OldRange = "A1" & ":" & ColLetter & "2"
    Let NewRange = "A3" & ":" & "B" & ColNumber
    Sheets("QuestionnaireData").Range(NewRange).Value = WorksheetFunction.Transpose(Range(OldRange))
    Rows(2).EntireRow.Delete
    Rows(1).EntireRow.Delete
End Sub

Upvotes: 0

Views: 225

Answers (1)

lsmetpitt
lsmetpitt

Reputation: 29

got it working

Sub ImportandTranspose()
ImportCSV
TransposeRawData
End Sub
Sub ImportCSV()
    Dim fileName As String
    fileName = Application.GetOpenFilename()
    ActiveCell.Range("A1").Select
    With ActiveSheet.QueryTables _
        .Add(Connection:="TEXT;" & folder & fileName, Destination:=Range("A1"))
        .FieldNames = True
        .AdjustColumnWidth = True
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
Sub TransposeRawData()
    Dim ColNumber As Long
    Dim ColLetter As String
    Dim OldRange As String
    Dim NewRange As String
    ColNumber = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    ColLetter = Split(Cells(1, ColNumber).Address, "$")(1)
    Let OldRange = "A1" & ":" & ColLetter & "2"
    Let NewRange = "A3" & ":" & "B" & ColNumber
    Sheets("QuestionnaireData").Range(NewRange).Value = WorksheetFunction.Transpose(Range(OldRange))
    Rows(2).EntireRow.Delete
    Rows(1).EntireRow.Delete
End Sub

Upvotes: 1

Related Questions