Split the row to column

[parscon]

Hello
I have data on Column A as ID and Column B but the data on column B some of them have - between data i need Split the row to column as the below images
Please help me i have a very big list .
Thank you so much
16469

[offthelip]

try this:


lastrow = Cells(Cells.Rows.Count, "A").End(xlUp)


inarr = Range(Cells(1, 1), Cells(lastrow, 2))
outarr = Range(Cells(1, 1), Cells(lastrow * 2, 2))
indi = 1
For i = 1 To lastrow
fnd = InStr(inarr(i, 2), "-")
If fnd = 0 Then
For k = 1 To 2
outarr(indi, k) = inarr(i, k)
Next k
indi = indi + 1
Else
outarr(indi, 1) = inarr(i, 1)
outarr(indi, 2) = Left(inarr(i, 2), fnd - 1)
indi = indi + 1
outarr(indi, 1) = inarr(i, 1)
outarr(indi, 2) = Mid(inarr(i, 2), fnd + 1, 255)
indi = indi + 1
End If
Next i

Range(Cells(1, 1), Cells(lastrow * 2, 2)) = outarr

[parscon]

Dear offthelip (http://www.vbaexpress.com/forum/member.php?60480-offthelip) Thank you so much Gear Work jut one thing
i have 20858492-20588772-1521920-8171944-8172497 in one cell on Column B and it do only for first 2 item . can you fix it also .
The first is okey

774 20858492
774 20588772-1521920-8171944-8172497

It mus be like

774 20858492
774 20588772
774 1521920
774 8171944
774 8172497

Thanks for your great work and help

[mdmackillop]

Please try to state your problem correctly from the start.

[mdmackillop]

Option Explicit
Sub Test()
Dim r As Range
Dim arr(), s, t, i As Long, j As Long, x As Long
Dim cel As Range


ReDim arr(100000)
Set r = Selection '<Adjust to suit
For Each cel In r
If cel <> "" Then
s = Split(cel, " ")
If InStr(1, s(1), "-") Then
t = Split(s(1), "-")
x = UBound(t)
For j = 0 To x
arr(i) = s(0) & " " & t(j)
i = i + 1
Next
Else
arr(i) = cel
i = i + 1
End If
End If
Next
ReDim Preserve arr(i)
Cells(1, 3).Resize(i).Value = Application.Transpose(arr)
End Sub

[parscon]

Dear mdmackillop
The code does not work you can see the sample file .

[offthelip]

Try running the code multiple times

[parscon]

Yes But after 5-6 time still some data that they are with - and will not change them

[offthelip]

sorry my mistake,
change the code to find the last row to:

lastrow= Range("A" & Rows.Count).End(xlUp).Row

[parscon]

appreciate for your work and Good Jon Man it is Done .

[mdmackillop]

Hi Parscon
If you can't take the time to explain your issue properly from the start and post a proper sample workbook, I won't waste more time on a solution.

[parscon]

Dear mdmackillop
I posted already sample thanks for your time and appreciate for your help.

[mdmackillop]

Your sample appeared in Post #6 and showed no desired output.

[snb]

Sub M_snb()
sn = Cells(1).CurrentRegion

For j = 1 To UBound(sn)
c00 = c00 & Replace("-" & sn(j, 2), "-", "|" & sn(j, 1) & "_")
Next
sp = Split(c00, "|")

Cells(1, 6).Resize(UBound(sp) + 1) = Application.Transpose(sp)
Cells(2, 6).CurrentRegion.TextToColumns , , , , 0, 0, 0, 0, -1, "_"
End Sub