PDA

View Full Version : [SOLVED] Open CSV File Automatic Separating Comma



fredlo2010
02-22-2014, 07:13 PM
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
02-23-2014, 01:36 AM
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
02-23-2014, 01:48 PM
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