Reorganise data onto different rows based on separator

ellison

Active Member
Joined
Aug 1, 2012
Messages
356
Office Version
  1. 365
Platform
  1. Windows
Hi, I'm wondering if there's a way that I can reorganise the data as below?

The data in Column B separates the different strings using ";"

And we'd like to separate each string of data out onto its own row, with its original Line ID?

Preferably on a separate results sheet, if at all poss :-)


Line_IDData Results (preferably on a different sheet):Line_IDData_V1
4orange;black;546324orange
12black;Grey4black
812222_4;WHITE;red454632
12black
12Grey
812222_4
81WHITE
81red
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Huge thanks for this....

I'm getting an error when I run this and when I hit debug, the line it highlights:

Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(spl) + 1) = .Cells(i, 1).Value
What us the error message? It ran without error for me.
 
Upvote 0
What us the error message? It ran without error for me.
Hi....

"run-time error "9":
subscript out of range"

Info as below on Sheet1: (No results sheet added)

re_rog_data_power_query_alt_play.xlsm
AB
1Line_IDData
24orange;black,54632
312black;Grey
4812222_4;WHITE;red
Sheet1



Many, many thanks!
 
Upvote 0
D
Hi....

"run-time error "9":
subscript out of range"

Info as below on Sheet1: (No results sheet added)



Many, many thanks!
If you don't have a sheet second sheet in that workbook, it will produce that error. You can add sheet 2, if that is the case. The error 9 occurs when the code tells the compiler to look for an object (range, sheet, workbook, control) and the object does not exist or the name is misspelled.

VBA Code:
Sub t()
Dim i As Long, spl As Variant
With ActiveSheet
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        spl = Split(.Cells(i, 2), ",")
       On Error Resume Next
       If IsError(Sheets(2)) Then
           Sheets.Add After:=Sheets(1)
        End If
        On Error GoTo 0
        Err.Clear
        Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(spl) + 1) = .Cells(i, 1).Value
        Sheets(2).Cells(Rows.Count, 2).End(xlUp)(2).Resize(UBound(spl) + 1) = spl
    Next
End With
End Sub
 
Upvote 0
D

If you don't have a sheet second sheet in that workbook, it will produce that error. You can add sheet 2, if that is the case. The error 9 occurs when the code tells the compiler to look for an object (range, sheet, workbook, control) and the object does not exist or the name is misspelled.

VBA Code:
Sub t()
Dim i As Long, spl As Variant
With ActiveSheet
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        spl = Split(.Cells(i, 2), ",")
       On Error Resume Next
       If IsError(Sheets(2)) Then
           Sheets.Add After:=Sheets(1)
        End If
        On Error GoTo 0
        Err.Clear
        Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(spl) + 1) = .Cells(i, 1).Value
        Sheets(2).Cells(Rows.Count, 2).End(xlUp)(2).Resize(UBound(spl) + 1) = spl
    Next
End With
End Sub

Huge thanks for your reply......

But I've got a gremlin in here somewhere, grr!

Have loaded up info onto mr_excel_reorg_test_02.xlsm

Sheet 1:
mr_excel_reorg_test_02.xlsm
AB
1Line_IDData
24orange;black,54632
312black;Grey
4812222_4;WHITE;red
Sheet1


Then I loaded up the second version of the code.

And I tried running it with (& without) creating sheet2.

I get the same set of results:

Sheet2:

mr_excel_reorg_test_02.xlsm
AB
1
24orange;black
34orange;black
412black;Grey
5812222_4;WHITE;red
sheet2




Huge apologies, any idea where I may be going wrong?!
 
Upvote 0
For one thing, the separators are not consistent. You have both commas and semicolons. The code is based on only commas.

But I see that the code does not fully produce what you want so I will again modify it.
 
Upvote 0
this seems to work like you want, using all commas as separators.
VBA Code:
Sub t2()
Dim i As Long, spl As Variant
With Sheets(1)
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        spl = Application.Transpose(Split(.Cells(i, 2), ","))
       On Error Resume Next
       If IsError(Sheets(2)) Then
           Sheets.Add After:=Sheets(1)
        End If
        On Error GoTo 0
        Err.Clear
        Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(spl)) = .Cells(i, 1).Value
        Sheets(2).Cells(Rows.Count, 2).End(xlUp)(2).Resize(UBound(spl)) = spl
    Next
End With
End Sub

Here is the data on sheet one.
Discussions.xlsm
AB
1Line_IDData
24orange,black,54632
312black,Grey
4812222_4,WHITE,red
Sheet1


and here is the results on sheet 2.

Discussions.xlsm
AB
1
24orange
34black
4454632
512black
612Grey
7812222_4
881WHITE
981red
Sheet2
 
Upvote 0
this seems to work like you want, using all commas as separators.
VBA Code:
Sub t2()
Dim i As Long, spl As Variant
With Sheets(1)
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        spl = Application.Transpose(Split(.Cells(i, 2), ","))
       On Error Resume Next
       If IsError(Sheets(2)) Then
           Sheets.Add After:=Sheets(1)
        End If
        On Error GoTo 0
        Err.Clear
        Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(spl)) = .Cells(i, 1).Value
        Sheets(2).Cells(Rows.Count, 2).End(xlUp)(2).Resize(UBound(spl)) = spl
    Next
End With
End Sub

Here is the data on sheet one.
Discussions.xlsm
AB
1Line_IDData
24orange,black,54632
312black,Grey
4812222_4,WHITE,red
Sheet1


and here is the results on sheet 2.

Discussions.xlsm
AB
1
24orange
34black
4454632
512black
612Grey
7812222_4
881WHITE
981red
Sheet2
Thank you so much and thanks again for persevering!!!

Massively appreciated :-)
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,215
Members
453,024
Latest member
Wingit77

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top