I am new to VBA Macro. I am trying to create a code that converts "Text to column" identifying semicolon as delimited. There is data in column has which has 1 values with ; as separator in between.

Now I want the macro to covert column b data text to column those Y Y should be in different column after text to column the new column name should be KPI wherein new column KPI should insert in-between Band C column the column C named SSO should push further columns....

Desired output as follows.

Sub TextToCol1()

Dim ws As Worksheet, lRow As Long
Set ws = ActiveWorkbook.Worksheets("Exp")

With ws
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A2:A" & lRow).TextToColumns Semicolon:=True
    
    '.Range("A2:A" & lRow).TextToColumns ConsecutiveDelimiter:=True, Semicolon:=True, Space:=True 'Option 1
    '.Range("A2:B" & lRow).Value = Application.Trim(.Range("A2:B" & lRow)) 'Option 2
    
    .Cells(1, 2).insertcolumn = "KPI"

End With
  
End Sub

Kindly help to fix this issue.

Please assist on this pop up this pop up should not come

See the popup only popup is the issue now

CodePudding user response：

Try:

Sub TextToCol1()

Dim ws As Worksheet, lRow As Long
Dim rng As Range
Dim c As Range

Set ws = ActiveWorkbook.Worksheets("Exp")

With ws
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set rng = .Range("B2:B" & lRow)
    For Each c In rng
        c = Trim(c)
        If Right(c, 1) = ";" Then c = Left(c, Len(c) - 1)
    Next c
    .Range("C:C").Columns(1).Insert
End With

With rng
    Application.DisplayAlerts=False 'Avoid false warning.
    .Columns.TextToColumns DataType:=xlDelimited, Semicolon:=True, Tab:=False, Space:=False, Comma:=False, Other:=False, Destination:=Range("$B$2:$C$"&lrow)  'Option 1
      Application.DisplayAlerts=True
     .Cells(1, 1).Offset(-1, 1).Value = "KPI"
    Set rng = .Resize(.Rows.Count, 2)
    For Each c In rng
        c = Trim(c)
    Next c
End With

Set rng = Nothing
Set ws = Nothing

End Sub