excelvbatext-to-column

VBA to convert text to columns in multiple sheets except one


I am new in VBA coding and and am trying to convert text in all sheets except one to text but have not achieved success. I have text in column A of each sheet and number of rows might differ.

This is what my code looks like

Sub text_to_column()
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim arr() As Variant, i As Long, nrCol As Long

    For Each ws In ThisWorkbook.Worksheets
     If ws.Name <> "Summary" Then
            ws.Select
            nrCol = 20
            ReDim arr(1 To nrCol) As Variant
            For i = 1 To nrCol
            arr(i) = Array(i, 1)
            Next
            Selection.TextToColumns _
            Destination:=Range("A1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=True, _
            Semicolon:=False, _
            Comma:=False, _
            Space:=False, _
            Other:=True, _
            OtherChar:="^", _
            FieldInfo:=arr, _
            TrailingMinusNumbers:=True
    End If
    Next ws

    End Sub

Please Guide.


Solution

  • Try this code

    Sub Test()
    Dim a, x, ws As Worksheet, r As Long
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Summary" Then
            For r = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
                x = Split(ws.Cells(r, 1).Value, "^")
                ws.Cells(r, 2).Resize(, UBound(x) + 1).Value = x
            Next r
        End If
    Next was
    End Sub
    

    And as for your approach, you can use such a code

    Sub TextToColumns()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Summary" Then
            Application.DisplayAlerts = False
                ws.Columns(1).TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="^", FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True
            Application.DisplayAlerts = True
        End If
    Next was
    End Sub