Macro to expand data across multiple rows

Hi everyone,

I have a spreadsheet with rows of data. Each row represents a separate product and column B contains all the colours for the product in each row. Each of the colours is separated by the pipe symbol. I need a macro to look at column B in each row and then create copies of each row depending on how many colours there are for the product.

I have attached an excel file with sample data. Sheet 1 contains 2 rows (excluding the header row). The first row contains 3 colours in Column B and the second row contains 6 colours in Column B. If you look at Sheet 2, you can see that there are now 9 rows, ie. 3 for the first SKU (in sheet 1) and 6 for the second SKU (in sheet 1) and each of the colours from column B is now separated out onto its own row.

I wondered if someone could help me out with some VBA code that would produce the results in sheet 2 from the data in sheet 1 based on the colours in column B?

Thanks in advance for any help offered.
test-data2.xlsx
LVL 1
gwh2Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saurabh Singh TeotiaCommented:
Use this code..This will create a copy of your data from sheet-1 to output sheet..

Sub arrangedata()
    Dim rng As Range, cell As Range
    Dim lrow As Long, lr As Long
    Dim ws As Worksheet, ws1 As Worksheet
    Dim str As Variant, st As Variant

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Output")

    ws1.Cells.Clear

    ws.Range("a1").EntireRow.Copy ws1.Range("A1")

    lrow = ws.Cells(Cells.Rows.Count, "b").End(xlUp).Row

    Set rng = ws.Range("B2:B" & lrow)

    For Each cell In rng

        str = Split(cell.Value, "|")

        For Each st In str

            lr = ws1.Cells(Cells.Rows.Count, "b").End(xlUp).Row + 1
            cell.EntireRow.Copy ws1.Range("A" & lr)
            ws1.Range("B" & lr).Value = st
        Next st


    Next cell

    ws1.Cells.EntireColumn.AutoFit


End Sub

Open in new window


Enclosed is the workbook post macro has run...

Saurabh...
test-data2.xlsm
0
gwh2Author Commented:
Thanks for the reply,

I ran your code but I got the following error:

Subscript out of range.

Do you know what might have gone wrong?
0
gwh2Author Commented:
The only difference in the test file and my own is that the first column in my own is called STYLE instead of SKU and the second column is called COLOURDES instead of COLOUR so I'm not sure whether this would have impacted the code?
0
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

Rgonzo1971Commented:
HI,

you could try this (not copying in a new sheet)

Sub macro()
For Idx = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    Set c = Cells(Idx, 2)
    If InStr(1, c, "|") > 0 Then
        Colors = Split(c, "|")
        NrColors = UBound(Colors)
        c.EntireRow.Copy
        Rows(c.Row + 1 & ":" & c.Row + NrColors).Insert Shift:=xlDown
        For Idx1 = 0 To NrColors
            c.Offset(Idx1) = Colors(Idx1)
        Next
    End If
Next
End Sub

Open in new window

Regards
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Saurabh Singh TeotiaCommented:
Gwh2,

I dont think that should create a difference..if you run the file which i uploaded you will see macro is running perfectly fine in the same..

If you still get the error can you post your sample file again with data where you get this error..

Saurabh...
0
gwh2Author Commented:
Thanks for the two sets of code,

Saurabh, as mentioend I tried your code but it didn't work and I tried it on the original test data also, but thank you anyway.

Rgonzo1971 - thanks for the code and it works as expected.

Much appreciated.
0
gwh2Author Commented:
Hi Rgonzo1971,

I'm sorry to have to come back to this. Your code works really well but I noticed that for it to work, the data requiring separating needs to be in Column B. I wondered if it was possible for you to show me how to adjust the code so that it will work if the data is in Column F instead?

Would really appreciate your help.

Thanks in advance.
0
gwh2Author Commented:
Hi,

Can you let me know if I need to post another question in order to have the code revised and the question solved?

Thanks in advance.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.