Solved: CSV File

[gmulhall]

Hi,

Could anyone point me to an Excel VBA routine or function that I can use in my own VBA code to split a CSV file where the file may have comma's imbedded in a field delimited by " " as well as fields not containing commas and so not surrounded by " ".

eg "ACRUX LIMITED",ACR,"Pharmaceuticals, Biotechnology & Life Sciences"

I've written the routine below but it is slow and I'd expect there is a better way - perhaps using an inbuilt Excel function.

Thanks,

Geoff


Sub ParseCSVRec(strInput As String)
Dim i As Long
Dim j As Long
Dim Char As String
i = 1
j = 0
While i <= Len(strInput)
Char = Mid(strInput, i, 1)
If Char = Chr(34) Then ' Double Quotes
i = i + 1
Char = Mid(strInput, i, 1)
j = j + 1
strWorkArray(j) = ""
While Char <> Chr(34)
strWorkArray(j) = strWorkArray(j) & Char
i = i + 1
Char = Mid(strInput, i, 1)
Wend
ElseIf Char <> Chr(44) Then
j = j + 1
strWorkArray(j) = ""
While Char <> Chr(44) ' Comma
strWorkArray(j) = strWorkArray(j) & Char
i = i + 1
Char = Mid(strInput, i, 1)
Wend
End If
i = i + 1
Wend
End Sub

[OBP]

Have you looked at the "Text to Columns" function under "Data"?

[tstom]

This example fills an array with about 1000 rows by 3 columns in about 80ms on my older computer...

http://home.fuse.net/tstom/New Folder.zip

[vba]
Option Explicit

Sub Example()
Dim MyCsvArray As Variant
'change the path to suit
MyCsvArray = CsvArray(ThisWorkbook.Path & "\sample.csv")

Call TestMyCsvArray(MyCsvArray)
End Sub

Function CsvArray(FileName As String) As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add("TEXT;" & FileName, Range("A1"))
.Name = "DoesNotMatter"
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1)
.Refresh BackgroundQuery:=False
End With
CsvArray = ActiveSheet.UsedRange
ActiveSheet.Delete
End Function

Sub TestMyCsvArray(MyCsvArray As Variant)
Dim CsvLineNumber As Long, CsvColumnNumber As Long
Dim RebuildLine As String

MsgBox "Line, " & UBound(MyCsvArray, 1) & Chr(13) & "Rows, " & UBound(MyCsvArray, 2)

For CsvLineNumber = LBound(MyCsvArray, 1) To UBound(MyCsvArray, 1)
RebuildLine = ""
For CsvColumnNumber = LBound(MyCsvArray, 2) To UBound(MyCsvArray, 2)
If RebuildLine = "" Then
RebuildLine = MyCsvArray(CsvLineNumber, CsvColumnNumber)
Else
RebuildLine = RebuildLine & "," & MyCsvArray(CsvLineNumber, CsvColumnNumber)
End If
Next
Debug.Print RebuildLine
Next
End Sub
[/vba]

[gmulhall]

Hi and thanks tstom I'll give it a go in my code.

Also thanks OBP - I'm looking to import a csv - but had not known about Text to columns.

Geoff

[gmulhall]

Hi - just to say thanks again tstom for the code. I've created a little add-in from it and it is very quick indeed !

Geoff

[tstom]

I'm looking to import a csv...

I guess I should have asked you that... There is no need to dump it to an array first. Just import it directly...

[gmulhall]

Yes...And thank you again !