Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
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)), TrailingMinusNumbers:=True
Is there a way to use Trim to eliminate the trailing spaces for the info that I split into columns? Here is part of the code to the macro that I'm using for the Spilt to Columns function. First timer. Thanks.
The fastest way to trim the data is to load it into an array, trim each element of the array, and write it back over the original data.
Sub TrimSelection()
Dim Data, v
Dim x As Long, y As Long
Data = Selection.CurrentRegion.Value
For x = 1 To UBound(Data, 1)
For y = 1 To UBound(Data, 2)
Data(x, y) = Trim(Data(x, y))
Next
Next
Selection.CurrentRegion.Value = Data
End Sub
Related
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 want to paste the columns of this text file in my workbook.
USAF-WBAN_ID STATION NAME COUNTRY STATE LATITUDE LONGITUDE ELEVATION
------------ ------------------------------ -------------------------------------------------- ------------------------------ -------- --------- ---------
404200 99999 AL AHSA SAUDI ARABIA +25.285 +049.485 +0179.2
I want to pull 7 variables (7 columns)
USAF-WBAN_ID; STATION NAME; COUNTRY; STATE; LATITUDE; LONGITUDE; ELEVATION
Below is what I've tried in several variations, and results are not reliable.
Sub A1_StationID()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
MsgBox "Please select weather stn.txt document"
Dim vFileName
vFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=vFileName, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(44, 1), _
Array(127, 1), Array(136, 1), Array(147, 1), Array(154, 1)), _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, TrailingMinusNumbers:=True
Set wbCopyFrom = Workbooks.Open(vFileName)
End Sub
Some of the output I get:
If I add a breakpoint on the second to last line of code, I get closer to the output I desire (with messed up columns).
First off - fantastic job posting working code and usable example data.
You were missing the array/field info designation for state and your final 3 columns were ~1/2 characters off. I removed the delimiter options as they don't matter if you're using xlFixedWidth.
Change
Workbooks.OpenText Filename:=vFileName, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(44, 1), _
Array(127, 1), Array(136, 1), Array(147, 1), Array(154, 1)), _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, TrailingMinusNumbers:=True
to
Workbooks.OpenText Filename:=vFileName, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(44, 1), _
Array(95, 1), Array(126, 1), Array(135, 1), Array(144, 1), Array(154, 1)), _
TextQualifier:=xlDoubleQuote, TrailingMinusNumbers:=True
As a side-note Excel has a bad tendency to remember Text to Columns settings so if you were messing with those earlier, make sure they are set to standard settings.
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
I have this code to split strings. Currently if the counter is equal to the number of rows on which data is present, it will run properly. However, this number of rows is variable. How do I make the for loop run for as long there is data?
Sub SplitToColumns()
Range("A1").Select
For Counter = 0 To 100 Step 1
Selection.TextToColumns Destination:=ActiveCell, 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)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(1, 0).Select
Next Counter
End Sub
Something like this:
get the row number of the last populated row in column A. (Replace with the column of your choice). Then use that row number in the for-loop, but start with 1, not with zero. Remove the debug.print if no longer required.
Sub SplitToColumns()
Dim rowCount As Long
rowCount = Cells(rows.Count, "A").End(xlUp).Row
Debug.Print rowCount
Range("A1").Select
For Counter = 1 To rowCount Step 1
Selection.TextToColumns Destination:=ActiveCell, 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)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(1, 0).Select
Next Counter
End Sub
There are several other ways to make this code more efficient. For example, you don't need to select the cell before you do a TextToColumns. In fact, you can do a TextToColumns on a range of cells, you don't need to loop through all the cells in the range.
Use the technique above to get the row number of the last row, and then build a range starting in A1 and extending to column A, last populated row number.
Then perform a TextToColumns on the whole range, all in one go. Much, much faster than looping!!!
Sub SplitToColumns()
Dim rowCount As Long
Dim ws As Worksheet
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
rowCount = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:A" & rowCount).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)), _
TrailingMinusNumbers:=True
End With
End Sub