Conside this Excel VBA macro:
Option Compare Text
Public Sub ColumnATextToColumns()
Dim rng As range
Set rng = Columns("A:A")
Dim nrColumns As Integer
nrColumns = CountCharacter(Cells(1, 1), "|") + 1
Dim FieldInfoVal As Variant
ReDim FieldInfoVal(1 To nrColumns)
For i = 1 To nrColumns
FieldInfoVal(i) = "Array(" & i & ", 2)"
Next i
rng.TextToColumns Destination:=range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=FieldInfoVal, _
TrailingMinusNumbers:=True
End Sub
Public Function CountCharacter(ByVal value As String, ByVal ch As String) As Integer
Dim char As String
Dim cnt As Integer
cnt = 0
For i = 1 To Len(value)
char = Mid(value, i, 1)
If char = ch Then cnt = cnt + 1
Next i
CountCharacter = cnt
End Function
It compiles and runs but nothing happens.
The macro without dynamic creation of the FieldInfo value does work:
Columns("A:A").Select
Selection.TextToColumns Destination:=range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12 _
, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2)), TrailingMinusNumbers:= _
True
Related
I use a simple macro, insert a "txt" file and then split it into columns
Sub POR_Import()
Dim ws As Worksheet, strFile As String
Call Smaz_vstup_POR
Set ws = ActiveWorkbook.Sheets("POR_IMPORT") 'set to current worksheet name
strFile = Application.GetOpenFilename("Text Files (*.*),*.*", , "Please select text file...")
With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
Call SplitPOR
i = MsgBox("Done", vbOKOnly + vbInformation)
End With
End Sub
and split
Sub SplitPOR()
Sheets("POR_IMPORT").Select
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("POR_divide").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="¦", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12 _
, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), _
Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array( _
25, 2), Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), Array(31, 2), _
Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2), Array(36, 2), Array(37, 2), Array( _
38, 2), Array(39, 2), Array(40, 2), Array(41, 1), Array(42, 2), Array(43, 2), Array(44, 2), _
Array(45, 2), Array(46, 2), Array(47, 2), Array(48, 2), Array(49, 2), Array(50, 2), Array( _
51, 2), Array(52, 2), Array(53, 2), Array(54, 2), Array(55, 2), Array(56, 2), Array(57, 2), _
Array(58, 2), Array(59, 2), Array(60, 2), Array(61, 2), Array(62, 2), Array(63, 2)), _
TrailingMinusNumbers:=True
End Sub
But every time I want to repeat the process I have to close and reopen excel. The moment you insert the txt for the second time excel will automatically split it according to how it was split the first time.
Is there please any possible treatment for this case?
Apologize once more for being obtuse and not understanding what you meant!
Please, try using the next optimized solution:
Sub POR_Import()
Dim ws As Worksheet, strFile As String
Call Smaz_vstup_POR
Set ws = ActiveWorkbook.Sheets("POR_IMPORT") 'set to current worksheet name
ws.UsedRange.ClearContents 'clear the previous used range content
'Normalize the TextToColumns behavior:____________________________________________________________
With ws.Range("A1")
.value = "1,2,3"
.TextToColumns Destination:=ws.Range("A1"), DataType:=xlDelimited, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.ClearContents
End With
'____________________________________________________________________________________________
strFile = Application.GetOpenFilename("Text Files (*.*),*.*", , "Please select text file...")
With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileTabDelimiter = True
.Refresh
End With
ws.QueryTables(ws.QueryTables.count).Delete 'delete the query after bringing the necessary text
SplitPOR ws 'call the splitting function with ws sheet as argument
MsgBox "Done", vbOKOnly + vbInformation
End Sub
Sub SplitPOR(ws As Worksheet)
Dim wsP_d As Worksheet, arrtxt(62), i As Long
Set wsP_d = Worksheets("POR_divide")
wsP_d.UsedRange.ClearContents 'clear the content, to not be ask about overwriting
wsP_d.Range("A:A").value = ws.Columns("B:B").value 'copy the column without using clipboard
For i = 0 To UBound(arrtxt) 'create the array to be passed to FieldInfo TextToColumns parameter
arrtxt(i) = Array(i + 1, 2)
Next i
'Use a more compact way:
wsP_d.Range("A:A").TextToColumns Destination:=wsP_d.Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, space:=False, Other:=True, OtherChar _
:="¦", FieldInfo:=arrtxt, TrailingMinusNumbers:=True
End Sub
Please, send some feedback after testing it. I will feel better knowing that I could help, after my stupid approach in comments, not being able to understand how what you were saying was possible...
I create a script in VBA that copy data from txt to spreadsheet, but cells are treated like a text even after formatting them to percent or number:
Sub PasteTextFileContent()
Dim wbExcel As Workbook, wbText As Workbook
Dim wsExcel As Worksheet
Set wbExcel = ThisWorkbook
Set wsExcel = wbExcel.Sheets("PastData")
Set wbText = Workbooks.Open("C:\Test\test.txt")
wbText.Sheets(1).Cells.Copy wsExcel.Cells
wbText.Close SaveChanges:=False
Sheets("PastData").Visible = True
Sheets("PastData").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1)), _
TrailingMinusNumbers:=True
Sheets("PastData").Visible = False
End Sub
I input data to text with:
Sub ToTxtFileSimpleButWorkingWell()
Dim strFile_Path As String
strFile_Path = "C:\Test\test.txt"
Open strFile_Path For Append As #1
Write #1, Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss"), Sheets("DASHBOARD").Range("V1").Value, Sheets("DASHBOARD").Range("V2").Value, Sheets("DASHBOARD").Range("V3").Value, Sheets("DASHBOARD").Range("V4").Value, Sheets("DASHBOARD").Range("V5").Value, Sheets("DASHBOARD").Range("V6").Value, Sheets("DASHBOARD").Range("V7").Value
Close #1
End Sub
How can I change that?
I would like to have a macro for converting a pipe-delimited csv/text file to to columns. When I recorded the macro, it tailored it to the number of columns in this dataset. How do I alter this code so that it accommodates any number of columns?
Sub Pipe2Col()
'
' Pipe2Col Macro
'
' Keyboard Shortcut: Ctrl+t
'
ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
DisplayAsIcon:=False
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
25, 1), Array(26, 1), Array(27, 1), Array(28, 1)), TrailingMinusNumbers:=True
End Sub
Simplist way would be to prebuild a FieldInfo array that you know is larger than the max number of columns in your source data
Here I've assumed that is 100 columns. Also cleaned up the recorder nonsense
Sub Demo()
Dim ws As Worksheet
Dim rng As Range
Dim FieldInfo() As Variant
Dim ColInfo() As Variant
Dim i As Long
Set ws = ActiveSheet
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, 1).End(xlUp))
ReDim FieldInfo(0 To 99)
ReDim ColInfo(0 To 1)
ColInfo(1) = 1
For i = 1 To 100
ColInfo(0) = i
FieldInfo(i - 1) = ColInfo
Next
rng.TextToColumns _
Destination:=rng.Cells(1, 1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:="|", _
FieldInfo:=FieldInfo, _
TrailingMinusNumbers:=True
End Sub
This code works using text to columns to separate column A into as many columns as I need, but I cannot figure out a way to make it do this with all columns outputted into text format.
Sub TxT_to_Columns()
ActiveWorkbook.ActiveSheet.Range("A:A").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:="|"
End Sub
How can I do the same thing but output all columns to text format?
Thank you,
You use FieldInfo:
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2)),
FieldInfo uses an array of arrays: Array(Array(Column,Type),...)
You can get the types from here:
https://learn.microsoft.com/en-us/office/vba/api/excel.xlcolumndatatype
If you know you want to do all the columns then you can pre fill an variant arr variable:
Sub TxT_to_Columns()
Dim arr(1 To 10) As Variant
arr(1) = Array(1, 2)
arr(2) = Array(2, 2)
arr(3) = Array(3, 2)
arr(4) = Array(4, 2)
arr(5) = Array(5, 2)
arr(6) = Array(6, 2)
arr(7) = Array(7, 2)
arr(8) = Array(8, 2)
arr(9) = Array(9, 2)
arr(10) = Array(10, 2)
ActiveWorkbook.ActiveSheet.Range("A:A").TextToColumns _
Destination:=ActiveWorkbook.ActiveSheet.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:="|", _
FieldInfo:=arr
End Sub
Firstly, all the credit must go to Scott Craner!
I will only show a shorter way of arrays building, as response at what #Sabatino Ognibene asked lately. I am sure that Scott knew that, but he wanted to present the array building in a way able to easily be understood.
Dim arr() As Variant, i As Long, nrCol As Long
nrCol = 12 'the number of columns you need to result
ReDim arr(1 To nrCol) As Variant
For i = 1 To nrCol
arr(i) = Array(i, 2) '2 will be used for `Text` formatting.
Next
I have this code and it gives me a Compile error: Expected Function or Variable.
How do i code this properly.
Sub test()
Dim wb As Workbook
Dim FiletoOpen
FiletoOpen = Application.GetOpenFilename(filefilter:="Text Files (*.csv), *.csv", MultiSelect:=False)
Set csv_wb = Workbooks.OpenText(Filename:=FiletoOpen, startRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1)))
End Sub
If I use Set csv_wb = Workbooks.Open (FiletoOpen) it works fine.
But there are specific fields in the file that I need to be in Text format.
So I cannot use this. But when I use the above, it gives me the error.
Any help would be much appreciated.
You have declared wb but using csv_WB Try This.
UNTESTED
Sub test()
Dim csv_WB As Workbook
Dim FiletoOpen
FiletoOpen = Application.GetOpenFilename(filefilter:="Text Files (*.csv), *.csv", MultiSelect:=False)
If FiletoOpen = False Then Exit Sub
Workbooks.OpenText Filename:=FiletoOpen, startRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1))
Set csv_WB = ActiveWorkbook
End Sub