locked
Split selected range into columns RRS feed

  • Question

  • Hello, 

    I have a huge range of data in columns separated by 3 empty columns. Each column has empty cells as well. Delimiters, "&" and "@", are available in those cells with data. What I need is to select the columns and run a Sub to split the cell contents into next column if the cell has the spiffed delimiter.

    Example below: The column with yellow headers has the data (some cells are empty) with decimeters, first the code will split to next column using the decimeter "&", then into second and third column using "@"

     

    I'd greatly appreciate any help.

    Thank you

    Thursday, December 27, 2018 10:38 AM

Answers

  • Hi,

    Not sure exactly what do you need by you can loop thru all the relevant columns and make this work

    Sub Test()

    Dim LastCol As Long
    Dim j As Long

    LastCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column

    Application.ScreenUpdating = False


    For j = 1 To LastCol
        Call txtToColumns(Columns(j))
    Next


    Application.ScreenUpdating = True


    End Sub


    Sub txtToColumns(TheRange As Range)

    'Set up the ranges
    Set TheRange = Intersect(TheRange, TheRange.Parent.UsedRange)

    On Error Resume Next

    TheRange.TextToColumns _
      Destination:=TheRange.Cells(1, 1), _
      DataType:=xlDelimited, _
      Tab:=False, _
      Semicolon:=False, _
      Comma:=False, _
      Space:=False, _
      Other:=True, _
      OtherChar:="&"
      
    Err.Clear
    On Error GoTo 0

       
    Set TheRange = Nothing

    End Sub


    Guy Zommer

    • Marked as answer by Ahmed Morsyy Thursday, December 27, 2018 1:14 PM
    Thursday, December 27, 2018 11:56 AM

All replies

  • Hi,

    Why not using Data text to column then you choose Delimiter & in other.



    Guy Zommer

    Thursday, December 27, 2018 10:55 AM
  • Hi Guy, 

    This is correct, but the problem is I have hundreds of columns.

    Thursday, December 27, 2018 11:01 AM
  • Hi,

    Not sure exactly what do you need by you can loop thru all the relevant columns and make this work

    Sub Test()

    Dim LastCol As Long
    Dim j As Long

    LastCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column

    Application.ScreenUpdating = False


    For j = 1 To LastCol
        Call txtToColumns(Columns(j))
    Next


    Application.ScreenUpdating = True


    End Sub


    Sub txtToColumns(TheRange As Range)

    'Set up the ranges
    Set TheRange = Intersect(TheRange, TheRange.Parent.UsedRange)

    On Error Resume Next

    TheRange.TextToColumns _
      Destination:=TheRange.Cells(1, 1), _
      DataType:=xlDelimited, _
      Tab:=False, _
      Semicolon:=False, _
      Comma:=False, _
      Space:=False, _
      Other:=True, _
      OtherChar:="&"
      
    Err.Clear
    On Error GoTo 0

       
    Set TheRange = Nothing

    End Sub


    Guy Zommer

    • Marked as answer by Ahmed Morsyy Thursday, December 27, 2018 1:14 PM
    Thursday, December 27, 2018 11:56 AM
  • Hi Guy, 

    That is exactly what I needed. An Application.DisplayAlerts = False will make the process easier.

    Thank you very much.


    Thursday, December 27, 2018 1:14 PM
  • No problem :-)


    Guy Zommer

    Thursday, December 27, 2018 1:16 PM
  • Hello Guy,

    Can you modify the code to insert entire column just before text to column step?

    Thank you.

    Friday, January 4, 2019 3:42 AM