I'm having trouble with CSV treatment in VBA:
I've got 1 input CSV file that need to be exported in 2 different CSV files, renaming certain columns and deleting others
Agents using the macro can't change local setting
I've got this code:
Dim fileBt As String
fileBt = SequoiaPath & Left(Filename, InStr(Filename, ".") - 1) & "/BT/NipBtSearch.csv"
FileCopy Path & Filename, fileBt
Dim Wbt As Excel.Workbook
Workbooks.OpenText Filename:=fileBt, DataType:=xlDelimited, Semicolon:=True
Set Wbt = ActiveWorkbook
Debug.Print Wbt.Sheets(1).Range("A1").Value
Wbt.Close True
Don't mind it's optimization, I've been testing for hours now and it's kind of a mess.
PS: The computer are set to French, so I'm guessing my default separator is ,.
Output:
NipBtSearch.csv is well formed, using correctly the semi-colons separator.
Debug.Print Wbt.Sheets(1).Range("A1").Value gives me the whole line
N° Dossier;Intitulé du dossier;N° Accès produit;Objet de l'accès produit;Domaine;Date d'initialisation;Heure d'initialisation...
If I try to change the value of A1, it breaks everything in my new CSV, I'm guessing because line 1 now has only one column.
So, as I was saying, I'm really struggling with this, I feel like I'm missing how to treat my CSV as a workbook with this range issue
You need to custom the output concatenating the values with your delimiter semicolon.
I made a fake origin source CSV dataset like this called csvfile.csv
Sub tets()
Dim WBsource As Workbook
Dim i As Long, j As Long, LastCol As Long
Dim FileSource As String, NewFileDestiny As String
Dim FullData As Variant
FileSource = "C:\Temp\csvfile.csv"
NewFileDestiny = "C:\Temp\newcsvfile.csv"
Set WBsource = Application.Workbooks.Open(FileSource, , , , , , , , ";", , , , , True)
With WBsource.ActiveSheet
'<---do whatever operations you do with data--->
.Cells.Replace "Value", "DummyText"
'<---end operations you do with data--->
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
FullData = .Range("A1").CurrentRegion.Value 'take all data into array
.Range("A1").CurrentRegion.Clear 'delete everything
'contatenate everything into Column A delimited by semicolon
For i = 1 To UBound(FullData)
'loop trough columns for each row of data and concatenate
For j = 1 To LastCol
.Range("A" & i).Value = .Range("A" & i).Value & FullData(i, j) & ";"
Next j
'after concatenate all, delete last semicolon
.Range("A" & i).Value = Left(.Range("A" & i).Value, Len(.Range("A" & i).Value) - 1)
Next i
End With
Erase FullData 'delete to clear memory
'output to NEW csv to not alter original file!!!
WBsource.SaveAs NewFileDestiny, xlCSV
'close file
WBsource.Close False 'we already saved before, no need to redo
End Sub
After executing code I get a new CSV file like this:
The TextToColumns method of the Range object automatically converts strings to numbers, but it would be nice to suppress this feature. The method has a TextQualifier parameter, but it doesn't seem to do what I'm looking for. The following data illustrates the issue. Strings in column A are delimited with semicolons that separate a text part from a number part. Note that the numbers all begin with zero, and that numbers in row 4-6 are prefixed with an apostrophe:
Column A
StringRow1;01000
StringRow2;02000
StringRow3;03000
StringRow4;'01000
StringRow5;'02000
StringRow6;'03000
The following macro splits the strings into a text part in Column B and a number part in Column C.
Sub TTC()
Application.DisplayAlerts = False
Dim rToSplit As Range
Set rToSplit = ThisWorkbook.Worksheets(1).Range("A1:A6")
rToSplit.TextToColumns _
Destination:=Range("B1"), _
DataType:=xlDelimited, _
Semicolon:=True, _
TextQualifier:=xlTextQualifierNone
End Sub
The last column illustrates the desired output:
Column A Column B Column C
Data Output Output Desired Output
StringRow1;01000 StringRow1 1000 01000
StringRow2;02000 StringRow2 2000 02000
StringRow3;03000 StringRow3 3000 03000
StringRow4;'01000 StringRow4 '01000 01000
StringRow5;'02000 StringRow5 '02000 02000
StringRow6;'03000 StringRow6 '03000 03000
I have tried formatting column C ahead of the split, like this:
rToSplit.Offset(, 3).NumberFormat = "#", but it has no effect. Switching the TextQualifier parameter to xlTextQualifierSingleQuote has the effect of treating rows 4-6 in the same way as rows 1-3.
Am I asking for the impossible? Or is there maybe some application level setting I'm not aware of? Or could I do something smart with the strings in column A?
(I could of course loop through Column C after the split and fix the issue, but for large data sets that's not attractive. For my particular application, the strings in column A are generated by code that searches for patterns in tens of thousands of text rows in several different text files; each match is added to a dictionary and then I use array() = Dictionary.Items and DestinationRange.Value = Application.WorksheetFunction.Transpose(array) to read the data to the worksheet. This is very fast. My workaround to deal with the issue described here is to save the number strings in a separate dictionary which is read to column C after the split. This works well, so I posted this out of curiosity to see what I can learn...)
You can use the FieldInfo property to set the data type for each column. You will need to know how many columns you have beforehand though, or know which column will contain the numbers.
The FieldInfo parameter takes an array of arrays, with each of the sub-arrays having 2 values. The first value represents the column number (starting at 1), and the second number is the XLColumnDataType you would like that column to be formatted as.
In this case, you'd like everything to be formatted as text (instead of a number, like it's currently doing), so you would use xlTextFormat (this is just a system defined constant equal to 2).
x.TextToColumns _
Destination:=Range("B1"), _
DataType:=xlDelimited, _
Semicolon:=True, _
TextQualifier:=xlTextQualifierNone, _
FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat)) 'Format columns 1 and 2 as text
If you are willing to do it with a loop:
Sub TTC()
Dim row As Long, lastRow As Long, splitSpot As Integer, cellValue As String
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets(1)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).row
For row = 1 To lastRow
cellValue = CStr(.Range("A" & row).Value)
splitSpot = InStr(cellValue, ";")
.Range("B" & row & ":C" & row).NumberFormat = "#"
.Range("B" & row).Value = Left(cellValue, splitSpot - 1)
If Mid(cellValue, splitSpot, 1) = "'" Then
.Range("C" & row).Value = Right(cellValue, Len(cellValue) - splitSpot + 1)
Else
.Range("C" & row).Value = Right(cellValue, Len(cellValue) - splitSpot)
End If
Next
End With
End Sub
ss:
Sub Macro9()
'
' Macro9 Macro
'
'
Selection.TextToColumns Destination := Range("A3"), DataType := xlFixedWidth, _
FieldInfo := Array(Array(0,1),Array(60,1),Array(63,1),Array(68,1),Array(71,1), _
Array(85,1),Array(88,1),Array(93,1),Array(99,1),Array(107,1),Array(111,1),Array _
(120,1),Array(123,1),Array(127,1),Array(130,1),Array(134,1),Array(143,1),Array( _
147,1),Array(157,1),Array(162,1),Array(165,1),Array(170,1),Array(202,1),Array( _
233,1),Array(236,1),Array(238,1),Array(248,1),Array(251,1),Array(260,1),Array( _
265,1),Array(277,1),Array(283,1),Array(287,1),Array(291,1),Array(295,1),Array( _
299,1),Array(302,1),Array(306,1),Array(310,1),Array(322,1),Array(326,1),Array( _
332,1),Array(335,1),Array(338,1),Array(344,1),Array(348,1),Array(356,1),Array( _
360,1),Array(367,1),Array(373,1),Array(375,1),Array(384,1),Array(387,1),Array( _
394,1),Array(398,1),Array(403,1),Array(409,1),Array(413,1),Array(419,1),Array( _
424,1),Array(429,1),Array(432,1),Array(438,1),Array(444,1),Array(449,1),Array( _
454,1),Array(458,1),Array(463,1),Array(468,1),Array(474,1),Array(478,1),Array( _
481,1),Array(484,1),Array(489,1),Array(493,1),Array(524,1),Array(554,1),Array( _
557,1),Array(563,1),Array(565,1),Array(577,1),Array(594,1),Array(613,1),Array( _
616,1),Array(620,1),Array(626,1),Array(629,1),Array(634,1),Array(646,1),Array( _
654,1),Array(659,1),Array(667,1),Array(669,1),Array(675,1),Array(683,1),Array( _
689,1),Array(696,1),Array(699,1),Array(706,1),Array(714,1),Array(717,1),Array( _
721,1),Array(728,1),Array(730,1),Array(743,1),Array(751,1),Array(754,1),Array( _
758,1),Array(767,1),Array(774,1),Array(779,1),Array(787,1),Array(790,1),Array( _
798,1),Array(805,1),Array(808,1),Array(817,1),Array(822,1),Array(826,1),Array( _
835,1),Array(845,1),Array(853,1),Array(857,1),Array(864,1),Array(869,1),Array( _
877,1),Array(881,1),Array(891,1),Array(895,1),Array(903,1),Array(912,1),Array( _
916,1),Array(920,1),Array(927,1),Array(933,1),Array(937,1),Array(941,1),Array( _
End Sub
I have 800 words in cell A3 in sheet input1, i recorded above macro by using function "Text to columns" in Excel 2007 which is giving error "Too many line continuations".
Can someone tell me the exact code please, indeed I want to add all the 800 words in different individual cells as one word in each cell in the same row.
I do not believe it is possible to tell the Macro Recorder to create longer lines so I do not think TextToColumns can be made to record this code for you.
You are using the fixed width option so words are starting at position 0, 60, 63, 68, 71 and so on. The start positions for about 120 words have been have been recorded so, if you wanted to build an array like this, you will have a lot of typing.
You say "words". To me that implies variable length strings separated by spaces. If that is correct, try the code below. It uses function Split to split cell A3 into words by space. These are then spread out along row 4 with any gaps created by double or triple spaces ignored.
Option Explicit
Sub SplitCell()
Dim CellCrnt As Long
Dim InxW As Long
Dim Word() As String
With Worksheets("input1")
Word = Split(.Range("A3"), " ")
CellCrnt = 1
For InxW = LBound(Word) To UBound(Word)
' Any double spaces will cause empty entries in Word.
' Ignore these empty entries
If Word(InxW) <> "" Then
.Cells(4, CellCrnt).Value = Word(InxW)
CellCrnt = CellCrnt + 1
End If
Next
End With
End Sub
I understand this is a fairly common problem, but I'm yet to find a reliable solution.
I have data in a csv file with the first column formatted dd/mm/yyyy. When I open it with Workbooks.OpenText it defaults to mm/dd/yyyy until it figures out that what it thinks is the month exceeds 12, then reverts to dd/mm/yyyy.
This is my test code, which tries to force it as xlDMYFormat, and I've also tried the text format. I understand this problem only applies to *.csv files, not *.txt, but that isn't an acceptable solution.
Option Base 1
Sub TestImport()
Filename = "test.csv"
Dim ColumnArray(1 To 1, 1 To 2)
ColumnsDesired = Array(1)
DataTypeArray = Array(xlDMYFormat)
' populate the array for fieldinfo
For x = LBound(ColumnsDesired) To UBound(ColumnsDesired)
ColumnArray(x, 1) = ColumnsDesired(x)
ColumnArray(x, 2) = DataTypeArray(x)
Next x
Workbooks.OpenText Filename:=Filename, DataType:=xlDelimited, Comma:=True, FieldInfo:=ColumnArray
End Sub
test.csv contains:
Date
11/03/2010
12/03/2010
13/03/2010
14/03/2010
15/03/2010
16/03/2010
17/03/2010
I had the same problem with the .OpenText method. My Regional Settings are English - AU rather than NZ.
I found another thread that suggested using .open,
( http://www.pcreview.co.uk/forums/date-format-error-csv-file-t3960006.html )
so I tried that
Application.Workbooks.Open Filename:=strInPath, Format:=xlDelimited, Local:=True
and it worked.
I had the exact same problem. This is a function that coverts dd/mm/yyyy to mm/dd/yyyy. Just feed it one date at a time. Hope it helps.
Function convertDate(x As String) As Date
'convert a dd/mm/yyyy into mm/dd/yyyy'
Dim Xmonth
Dim XDay
Dim XYear
Dim SlashLocation
Dim XTemp As String
XTemp = x
SlashLocation = InStr(XTemp, "/")
XDay = Left(XTemp, SlashLocation - 1)
XTemp = Mid(XTemp, SlashLocation + 1)
SlashLocation = InStr(XTemp, "/")
Xmonth = Left(XTemp, SlashLocation - 1)
XTemp = Mid(XTemp, SlashLocation + 1)
XYear = XTemp
convertDate = Xmonth + "/" + XDay + "/" + XYear
End Function
At the end of your "Workbooks.OpenText" line, add Local:=True
Workbooks.OpenText filename:=filename, DataType:=xlDelimited, Comma:=True, FieldInfo:=ColumnArray, Local:=True
This worked on my pc when I changed my region to English(NZ).
EDIT: And now I see somebody else gave the same answer. :-)
Realise this is a little late, but if you combine the local and array qualifiers it should work correctly:
Workbooks.OpenText Filename:=FileName, _
FieldInfo:=Array(Array(1, 4), Array(2, 1)), Local:=True
I am trying to read in a txt file and use Australian date format dd/mm/yyyy but I do know if you are opening a text file with the Workbooks.Open function you can set the date to local.. by adding Local:=True
Ex
Workbooks.Open Filename:=VarOpenWorkbook, Local:=True
this works for me...
This seems to do the trick, but is still a hack. I will add a check that no dates in the range are more than one day apart, to make sure that data imported correctly as dd/mm/yyyy isn't reversed.
Question still open for a solution, rather than a method of patching up the problem.
Thanks to posts thus far.
Function convertDate(x As String) As Date
' treat dates as mm/dd/yyyy unless mm > 12, then use dd/mm/yyyy
' returns a date value
Dim aDate() As String
aDate = Split(x, "/")
If UBound(aDate) <> 2 Then
Exit Function
End If
If aDate(0) > 12 Then
d = aDate(0)
m = aDate(1)
Else
d = aDate(1)
m = aDate(0)
End If
y = aDate(2)
d = Lpad(d, "0", 2)
m = Lpad(m, "0", 2)
If Len(y) = 4 Then
Exit Function ' full year expected
End If
uDate = y & "-" & m & "-" & d & " 00:00:00"
convertDate = CDate(uDate)
End Function
Function Lpad(myString, padString, padLength)
Dim l As Long
l = Len(myString)
If l > padLength Then
padLength = l
End If
Lpad = Right$(String(padLength, padString) & myString, padLength)
End Function
The solutions i've used are;
Change the file name from .csv to .txt and then try importing again (but it sounds like this isn't appropriate
Change the region settings on your PC. If you're English, Australian, New Zealand etc and typically use dd/mm/yyyy then maybe Windows was installed incorrectly as US date formats etc.
Either import it all as text and then convert, or write some code to parse the file. Either way you'll need to ensure you're getting the right dates.This is where the Universal Date format and CDATE() can help you out.
The function below reads a string and changes it to a dd/mm/yyyy date. You'll have to format the cell as a date though. Please note that this will not help if you have imported the values as dates already.
You can use this in code or as a function (UDF) if you through it into a module.
Function TextToDate(txt As String) As Date
Dim uDate As String
Dim d, m, y As String
Dim aDate() As String
aDate = Split(txt, "/")
If UBound(aDate) <> 2 Then
Exit Function
End If
d = Lpad(aDate(0), "0", 2)
m = Lpad(aDate(1), "0", 2)
y = aDate(2)
If Len(y) = 2 Then ''# I'm just being lazy here.. you'll need to decide a rule for this.
y = "20" & y
End If
''# Universal Date format is : "yyyy-mm-dd hh:mm:ss" this ensure no confusion on dd/mm/yy vs mm/dd/yy
''# VBA should be able to always correctly deal with this
uDate = y & "-" & m & "-" & d & " 00:00:00"
TextToDate = CDate(uDate)
End Function
Function Lpad(myString As String, padString As String, padLength As Long) As String
Dim l As Long
l = Len(myString)
If l > padLength Then
padLength = l
End If
Lpad = Right$(String(padLength, padString) & myString, padLength)
End Function
Here is the code... My first column is a DD/MM/YYYY date and the second column is text... The Array(1,4) is the key...
Workbooks.OpenText Filename:= _
"ttt.txt", Origin:=437, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), Array(2, 1)), _
TrailingMinusNumbers:=True
The value is recognised as a proper date... You need apply the format of DD/MM/YY to the first column after this.
What I just found out is, you have to assign your local date to variable type of Date. I don't understand why it helps, but it sure does.
dim xDate As Date
xDate = PresDate.Value ' it is my form object let say it has 03/09/2013
curRange.Value = xDate ' curRange is my cur cell
While transfering dd/mm/yyyy to xDate it remains dd/mm/yyyy and after putting it in excel doesn't change it. Why? I have no idea. But after many tries it helped. Hope it will help for many of people =)
Try this:
Workbooks.OpenText Filename:=Filename, DataType:=xlDelimited, Comma:=True
Excel should correctly interpret those date values as dates, even if you prefer a different formatting. After executing the OpenText method, determine which column contains the date values and change the formatting so that it suits you:
CsvSheet.Columns(1).NumberFormat = "dd/mm/yyyy"