The code attached below is to split text to columns. I get an error when I run this code.
The data to be split is as follows:
NAME,1244
NAME,4356
NAME,5678
The number of lines with NAME is variable. I get run time error 1004, No data was selected to parse. How to solve this?
Sub SplitNameToColumns()
Dim rowCount As Long
rowCount = Cells(Rows.Count, "F").End(xlUp).Row
Range("F2").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)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(1, 0).Select
Next Counter
End Sub
Try this:
Sub SplitAndScatter()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "F").End(xlUp).Row
With Range("F2:F" & LastRow)
.TextToColumns Destination:=Range("F2"), DataType:=xlDelimited, Comma:=True
End With
End Sub
This is taken and modified from another question I answered here.
Let us know if this helps.
Related
I have a macro that imports a txt file and displays some XY co-ordinates in a scatter graph. I'd like to be able choose a folder then hit next/back to view the other files in the folder rather than select each file individually.
This is the macro, each time I select the file, it pastes the XY values into the relevant place on the sheet (I have to do it this way to pick out the columns I need from the source data). The tool is useful but would be 10x better if I could hit one button to see the next file as I often have 30+ files to check
Public Sub TxtToCol()
'Step1: delete existing contents
Columns("A:j").Select
Selection.ClearContents
Range("A1").Select
'Updated to include ImportText macro into main code
Dim textFileNum, rowNum, colNum As Integer
Dim textFileLocation, textDelimiter, textData As String
Dim tArray() As String
Dim sArray() As String
textFileLocation = Application.GetOpenFilename()
'If no file selected stop macro
If textFileLocation = False Then Exit Sub
textDelimiter = ","
textFileNum = FreeFile
Open textFileLocation For Input As textFileNum
textData = Input(LOF(textFileNum), textFileNum)
Close textFileNum
tArray() = Split(textData, vbLf)
For rowNum = LBound(tArray) To UBound(tArray) - 1
If Len(Trim(tArray(rowNum))) <> 0 Then
sArray = Split(tArray(rowNum), textDelimiter)
For colNum = LBound(sArray) To UBound(sArray)
ActiveSheet.Cells(rowNum + 1, colNum + 1) = sArray(colNum)
Next colNum
End If
Next rowNum
'MsgBox "Data Imported Successfully", vbInformation
'Find XY co-ordinates, text to columns with 'space' delimiter, select full range then cut and paste into new area
Cells.Find(What:="+00.000", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
:="=", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("D9").Select
ActiveSheet.Paste
'Now co-ords are moved, remaining data can be delimited by '='
Range("A1").Select
Range(Selection, Selection.End(xlDown)).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)), TrailingMinusNumbers:=True
'Add updated cant formula to avoid Vlookup error
Range("U5").Formula = (Range("E9") - Range("E10")) * 1000
'Return to cell A1
Range("A1").Select
'MsgBox "Data Imported Successfully", vbInformation
End Sub
I want to create a vba macro that transforms text to columns, but this command is only capable of doing column by column.
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
This code above works whell for one column, but i would like to do the command for the columns F to BL.
How can i do a For Loop to iterate over all the columns between F and BL?
Some sort of For Columns in Range Do?
Something like this should give you an idea of what you can do.
Note that you don't need to select. And most of those option are probably set to their default value, making the code unecessary verbose. The macro recorder is nice but you might want to rework the result.
Sub quick_and_dirty()
Dim cell As Range
For Each cell In Range("F1:G1")
cell.EntireColumn.TextToColumns Destination:=cell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Next cell
End Sub
You are going to run into an issue with regard to overwriting existing data, so the route you want to follow is dependent on how you want to address that.
If you use AugustinLopez' method above, you'd want to make a handful of adjustments either way.
If you want to copy each row to a new sheet and then expand it, just add a "cell.EntireColumn copy xxx" step before the TextToColumns step and copy it to a new range.
If you want to add the necessary number of empty columns first, and presuming you have a variable number of commas through out the columns, it gets trickier and you'd need something like this (depending on your table size, some optimization for speed may be needed):
Sub DummyCode()
Dim cell As Range
Dim ColumnCount As Integer
Dim RangeOfInterest As Range
Dim CellStart As Integer
Dim i As Integer
Dim j As Integer
Dim CommaCount As Integer
Set RangeOfInterest = Range("F1:BL1")
ColumnCount = RangeOfInterest.Columns.Count
CellStart = RangeOfInterest.Range("A1").Column
For i = CellStart + ColumnCount - 1 To CellStart Step -1 'you gotta go backwards to not mess up your count
CommaCount = 0
For Each cell In Intersect(Cells(1, i).EntireColumn, ActiveSheet.UsedRange)
If InStr(1, cell.Value, ",") > 0 Then
If CommaCount < (Len(cell.Value) - Len(Replace(cell.Value, ",", ""))) Then
CommaCount = (Len(cell.Value) - Len(Replace(cell.Value, ",", "")))
'credit for the above bit of cleverness goes to here:
'http://www.ozgrid.com/forum/showthread.php?t=45651
'via here
'https://stackoverflow.com/questions/9260982/how-to-find-number-of-occurences-of-slash-from-a-strings
End If
End If
For j = 1 To CommaCount
Cells(1, i).EntireColumn.Insert
Next j
Cells(1, i).EntireColumn.TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Next i
End Sub
good luck!
I have tested my macro many times through VBA Run Window, and all on Sheet2 appears correctly. When I try to run Macro from Button on Sheet1, two columns "C" and "D" raise all the numbers by one cell up. What could be the issue on Button, Sheet1?
At the same time, this script code has been arranged to delete content from empty rows with additional words, or letters, then it is suppose to delete a row up, perhaps, this could be the issue.
My code:
Sub CopyPasteintoSheet2()
Dim lr As Long
Dim i As Long
Dim inputdtae As Date
Dim rng As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr - 0 To 2 Step -1
If Cells(i, "B") = "LLC" Then
Cells(i, "B").EntireRow.Delete
End If
Next i
ActiveWindow.SmallScroll Down:=11
Columns("J:J").Select
Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("R:R").Select
Selection.TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Dim LastRow As Long
Dim NEWFORMAT As Worksheet
Dim Results As Worksheet
Set Results = Sheets("NEWFORMAT")
LastRow = Results.Cells(Results.Rows.Count, "Z").End(xlUp).Row
Range("A15:A400").Copy
Results.Range("A" & LastRow + 2).PasteSpecial xlValues
Range("B15:B400").Copy
Results.Range("B" & LastRow + 2).PasteSpecial xlValues
Range("J15:J400").Copy
Results.Range("C" & LastRow + 2).PasteSpecial xlValues
Range("R15:R400").Copy
Results.Range("D" & LastRow + 2).PasteSpecial xlValues
Application.DataEntryMode = False
End Sub
my task is:
1) Select all cells in A row which contain values (done).
2) Text to Columns - example value 2017.01.01
Sub selectAndToColumns()
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & LR).SpecialCells(xlCellTypeConstants, 23).Select
'2nd step
Selection.TextToColumns Destination:=Range(A1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 1))
End Sub
1 step is ok, but how can I use my selection instead of Range(A1) in 2nd step? Can I make a variable and how?
I'm not too sure about your requirements, but this will perform the TextToColumns without selecting anything (You can still change the destination to wherever you want the resulting data to be placed, you can do this by specifying a range or even using a variable where your range is stored):
Sub selectAndToColumns()
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & LR).SpecialCells(xlCellTypeConstants, 23).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 1))
End Sub
UPDATE
If you want to replace your destination with a variable instead of Range("A1") then something like below will work:
Sub selectAndToColumns()
Dim DestinationRange As String
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
DestinationRange = "D1"
MsgBox DestinationRange
Range("A1:A" & LR).SpecialCells(xlCellTypeConstants, 23).TextToColumns Destination:=Range(DestinationRange), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 1))
End Sub
I'm not sure if I have understood your question properly, but if you just want to select Column A and paste it as values, I would use:
Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
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