VBA Excel text to column data returns one row only

Question

I am fighting with the code, which constantly returns one velue only. My amount of rows is flexible. Sometimes I have 10 sometimes 60, so i can't set the fixed range. The End(xlDown) doesn't help too.

To clarify roughly my problem I am showing the code and output image below:

 Sub Texttocolumns()
 Columns("E:E").Insert

 Range("E1") = "SAO"
 Range("D2", Range("D2).End(xlDown)).Texttocolumns _
 Destination:=Range("D2"), DataType:=xlDelimited, Space:=True
 Columns("D").AutoFit
 Range("D2", Range("D2").End(xlDown)).Copy
 Range("D2", Range ("D2").End(xlToRight).End(xlDown)).PasteSpecial _
 Paste:=xlPasteFormats
 Application.CutCopyMode = True

 End Sub

I tried another ways like, instead of Range("D2") I put Range("D"), what didn't work. The same as in Destination, where instead of Range("D2") I put Range("D2").End(xlDown), what triggered an error from debugger.

How can I make this whole list running properly?

[This is the right way to find the last row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba). — BigBen, Mar 25 '20 at 13:35
It's angry at ` Range("D2", Range ("D2").End(xlToRight).End(xlDown)).PasteSpecial _ Paste:=xlPasteFormats`. That space between `Range` and `("D2")` means it's not formatted correctly. — Mech, Mar 25 '20 at 13:37

Mech · Answer 1 · 2020-03-25T14:11:16.063

1

This should do what you are looking for. I've commented so it should be clear but feel free to ask any follow up questions below.

 Sub Texttocolumns()
 Dim wb As Workbook: Set wb = ThisWorkbook
 Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
 Dim LastRow As Long

 ws.Columns("E:E").Insert
 LastRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row

 ws.Range("E1") = "SAO"
 ws.Range(ws.Cells(2, 4), ws.Cells(LastRow, 4)).Texttocolumns Destination:=ws.Cells(2, 4), DataType:=xlDelimited, Space:=True
 ws.Columns("D").AutoFit
 ws.Range(ws.Cells(2, 4), ws.Cells(LastRow, 4)).Copy
 ws.Cells(2, 4).PasteSpecial

 Application.CutCopyMode = True

 End Sub

edited Mar 25 '20 at 14:11

answered Mar 25 '20 at 13:47

Mech

3,952
2
14
25

Here I am getting error: https://stackoverflow.com/questions/33070010/compile-error-named-argument-not-found I changed my Sub to Texttocolumn, but is the same – Geographos Mar 25 '20 at 17:17
1

Works well on my end. The sub name won't make a difference. Can you go to the sub and press F8 until you find the line containing the error? – Mech Mar 25 '20 at 17:23

score 1 · Accepted Answer · answered Mar 25 '20 at 16:33

A TextToColumns Ride

The comments should help you change the code where I misunderstood. If not, feel free to ask for details in the comments below.

Sub TextToCol()

    Const rowTitle As Long = 1        ' Title (Header) Row
    Const FR As Long = 2              ' First Record Row
    Const colSource As Long = 4       ' Source Column
    Const colTarget As Long = 5       ' Target Column
    Const strTitle As String = "SAO"  ' Target Column Title (Header)

    Dim rngCopy As Range              ' Source Record Range
    Dim rngPaste As Range             ' Paste Range
    Dim LR As Long                    ' Last Record Row
    Dim LC As Long                    ' Last Record Column

    ' Insert a new column (Target Column) after Source Column.
    Columns(colTarget).Insert
    ' Write Target Column Title.
    Cells(rowTitle, colTarget) = strTitle

    ' Calculate Last Record Row (from bottom to top) in Source Column.
    LR = Cells(Rows.Count, colSource).End(xlUp).Row
    ' Check if there are any records (data).
    If LR <= 1 Then MsgBox "No Records!": Exit Sub
    ' Calculate Source Record Range.
    Set rngCopy = Cells(FR, colSource).Resize(LR - FR + rowTitle)

    ' To avoid Excel complaining about data in cells when using TextToColumns,
    ' disable DisplayAlerts.
    Application.DisplayAlerts = False

        ' Apply TextToColumns on Source Record Range.
        rngCopy.TextToColumns Destination:=Cells(FR, colSource), _
          DataType:=xlDelimited, Space:=True

    ' Enable DisplayAlerts.
    Application.DisplayAlerts = True

    ' Apply Autofit on Source Column.and Target Columns.
    Columns(colSource).AutoFit
    ' Apply Autofit on Target Column.
    Columns(colTarget).AutoFit

    ' Calculate Last Record Column using Title Row.
    LC = Cells(rowTitle, Columns.Count).End(xlToLeft).Column

    ' Copy Source Record Range.
    rngCopy.Copy

    ' Calculate Paste Range.
    Set rngPaste = rngCopy.Offset(, colTarget - colSource) _
      .Resize(, LC - colTarget + 1)

    ' Paste formats of Source Record Range to Paste Range.
    rngPaste.PasteSpecial Paste:=xlPasteFormats

    ' Turn off CutCopyMode.
    Application.CutCopyMode = False

End Sub

VBA Excel text to column data returns one row only

2 Answers2

A TextToColumns Ride