Link to home
Start Free TrialLog in
Avatar of CAE5942
CAE5942

asked on

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
Avatar of Saurabh Singh Teotia
Saurabh Singh Teotia
Flag of India image

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
Avatar of CAE5942
CAE5942

ASKER

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?
Avatar of CAE5942

ASKER

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?
ASKER CERTIFIED SOLUTION
Avatar of Rgonzo1971
Rgonzo1971

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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...
Avatar of CAE5942

ASKER

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.
Avatar of CAE5942

ASKER

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.
Avatar of CAE5942

ASKER

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.