Open CSV File Automatic Separating Comma

[fredlo2010]

Hello guys,

I have a CSV file and I want to open using VBA and then copy certain data into my sheet.

This is something fairly easy to do with

Workbooks.Open ("C:\Users\Alfred\Desktop\test.csv")

Once the file is open I would do a TextToColumn and my data would be there.

All great except for one thing. If my CSV file contains a Comma in the data even though Commas are not my delimiter Excel will put my data in two different columns. When I do TextToColumns I get the warning "There is data already there do you want to replace it ?"

My way around it was to create a procedure that loops through each cells divides based on my true identifier ( using Split) and then pastes the data somewhere else and then moves to the next column; if there is no more columns then it will move to the next row. .

This method works fine with my test cases but when I tried it with a 5000 row workbook. Disaster stroke! It took forever, about 3 minutes.

I am wondering if you guys have ever experience something similar or know a way around it.

This is the code I have :

Sub ImportCSVLineByLine()
    
Dim wb As Workbook
Dim shOrigen As Worksheet, shTarget As Worksheet
Dim strFileName As String, strSheetName As String
Dim lRowOrigen As Long, lColOrigen As Long, lNextCol As Long, lUpArray As Long
Dim arrData As Variant
Dim i As Integer, j As Integer
    
    
    On Error GoTo Err_Handler
        Set wb = Workbooks.Open(Filename:=strFileName)
    On Error GoTo 0
    
    Set shOrigen = wb.ActiveSheet
    
    lRowOrigen = shOrigen.Cells(Rows.Count, "A").End(xlUp).Row
    
       
        ' Add the new sheet that will hold the data.
        Set shTarget = wb.Sheets.Add(after:=Sheets(Sheets.Count))
        
        For i = 1 To lRowOrigen
            lColOrigen = shOrigen.Cells(i, Columns.Count).End(xlToLeft).Column
            For j = 1 To lColOrigen
                arrData = Split(shOrigen.Cells(i, j).Value, "|")
                
                ' Start transfering the data.
                lNextCol = shTarget.Cells(i, Columns.Count).End(xlToLeft).Column + 1
                If lNextCol = 2 Then lNextCol = 1
                
                lUpArray = UBound(arrData)
                If lUpArray = 0 Then lUpArray = 1
                
                shTarget.Cells(i, lNextCol).Resize(1, lUpArray + 1).Value = arrData
            Next j
        Next i
    
        ' Copy the values to fix issues with convert to number.
        shTarget.Range("A1").CurrentRegion.Value = _
        shTarget.Range("A1").CurrentRegion.Value
        
        ' Delete the original sheet and rename the new sheet.
        strSheetName = shOrigen.Name
        
        Application.DisplayAlerts = False
            shOrigen.Delete
        Application.DisplayAlerts = True
        
        ' Rename the sheet crated to match the original one.
        shTarget.Name = strSheetName
        shTarget.Cells.Columns.AutoFit


    
Exit_Handler:
    Set wb = Nothing
    Set shOrigen = Nothing
    Set shTarget = Nothing
    
    Exit Sub


Err_Handler:
    MsgBox "The file you are trying to open was not found", vbOKOnly + vbInformation, "File Not Found"
    Application.ScreenUpdating = True
            
    Resume Exit_Handler
End Sub

Thanks for the help

[westconn1]

perhaps you should be using the opentext method, where you can specify the correct delimiter?

excel treats csv files specifically, which will over ride the opentext method, so you might have to rename the file before opening, to .txt or any other extension excel does not recognise

[fredlo2010]

Thanks for the tip westconn1,

It works perfectly.I was messing with it today and this is a mockup of my new redesigned code.

Sub tryOpenCSV()


    Const strOrigenFullPath As String = "C:\Users\Alfred\Desktop\test.csv"
    Const strDestFullPath As String = "C:\Users\Alfred\Documents\test.csv"
    Const strNewNamedPath As String = "C:\Users\Alfred\Documents\test.txt"


    ' Make a copy of the file in the documents
    On Error GoTo Err_Handler
        FileCopy strOrigenFullPath, strDestFullPath
    On Error GoTo 0
    
    ' if the file exists delete it and then rename it to .txt
    On Error Resume Next
        Kill strNewNamedPath
        Name strDestFullPath As strNewNamedPath
    On Error GoTo 0
    
    ' open the file
    Workbooks.OpenText strNewNamedPath, , , xlDelimited, , , , , , , True, "|"


    ' close file
    ActiveWorkbook.Close False


    ' delete the txt file
    Kill strNewNamedPath


Exit_Handler:
    Exit Sub


Err_Handler:
    MsgBox "The file you are trying to access is in use or does not exist."


    Resume Exit_Handler


End Sub

Also I was checking performance and and the old code took me about 5.5 seconds to run; the new one 0.43 that's 92% faster

Thanks