One cell string to convert mulitple cell

[kevatarvind]

I have data like below

Sheet1

*	A
1	DEX/25/26/48/80
2	REX/88/125/358/10
3	MEX/25/10/2/3/4/108

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:280px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

Want to convert like below

Sheet1

*	A
1	DEX/25
2	DEX/26
3	DEX/48
4	DEX/80
5	REX/88
6	REX/125
7	REX/358
8	REX/10
9	MEX/25
10	MEX/10
11	MEX/2
12	MEX/3
13	MEX/4
14	MEX/108

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:280px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

 

[Peter_SSs]

See if this is any use.

Sub Convert_Data()
  Dim p As String
  Dim c As Range
  Dim b
  Dim nr As Long, rws As Long
  
  Const d As String = "/"
  
  Application.ScreenUpdating = False
  nr = 1
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    b = Split(c.Value, d)
    p = b(0)
    rws = UBound(b)
    Cells(nr, "B").Resize(rws).Value = Application.Transpose(Split(p & d & Join(Filter(b, p, False), " " & p & d)))
    nr = nr + rws
  Next c
  Application.ScreenUpdating = True
End Sub

 

[kevatarvind]

Thanks Peter For your Help Code Working Perfect just i need the result in same column is this possible ?

 

[hiker95]

kevatarvind,

Sample raw data:

Excel 2007
	A
1	DEX/25/26/48/80
2	REX/88/125/358/10
3	MEX/25/10/2/3/4/108
4
5
6
7
8
9
10
11
12
13
14
15
Sheet1

After the macro:

Excel 2007
	A
1	DEX/25
2	DEX/26
3	DEX/48
4	DEX/80
5	REX/88
6	REX/125
7	REX/358
8	REX/10
9	MEX/25
10	MEX/10
11	MEX/2
12	MEX/3
13	MEX/4
14	MEX/108
15
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ReorgData()
' hiker95, 04/15/2013
' http://www.mrexcel.com/forum/excel-questions/697082-one-cell-string-convert-mulitple-cell.html
Dim r As Long, lr As Long, s, nr As Long, i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 1 Step -1
  If InStr(Cells(r, 1), "/") > 0 Then
    nr = r
    s = Split(Cells(r, 1), "/")
    Rows(r + 1).Resize(UBound(s) - 1).Insert
    For i = 1 To UBound(s)
      Cells(nr, 1) = s(0) & "/" & s(i)
      nr = nr + 1
    Next i
  End If
Next r
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.

 

[Peter_SSs]

Thanks Peter For your Help Code Working Perfect just i need the result in same column is this possible ?

Add the blue line of code

  Next c
  Columns("A").Delete
  Application.ScreenUpdating = True

I'm not suggesting you use this one (though you could, with maybe a little more tidying) - it was just for fun and to keep RR happy.

Sub Convert_Data_v2()
  Dim c As Range

  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(UBound(Split(c.Value, "/"))).Value = _
      Application.Transpose(Split(Split(c.Value, "/")(0) & "/" & Join(Filter(Split(c.Value, "/"), Split(c.Value, "/")(0), False), " " & Split(c.Value, "/")(0) & "/")))
  Next c
End Sub

 

[kevatarvind]

Thanks Hiker95 its working perfect thanks A Ton Both Peter and Hiker your people Are Brilliant

 

[hiker95]

kevatarvind,

Thanks for the feedback.

You are very welcome. Glad we could help.

Come back anytime.