numbers from one row into seperate rows

Microsoft Microsoft excel 2007 full vers...
September 20, 2010 at 10:31:33
Specs: Windows 7
I have a spread sheet with 2 columns.
1st column has a number, 2nd column has many numbers i.e., 10001, 10002, 10003, all separated by commas

Column 1 Column 2
10000 10001, 10002, 10003 etc....
10004 10005, 10006, 10006 etc...

I want to take the numbers from column 2 and put them in separate rows with the number from column 1 in each row it creates.

Column 1 Column 2
10000 10001
10000 10002
10000 10003
10004 10005
10004 10006
10004 10007

This would be easy for me if I had MS Access, but I do not.
I appreciate any help as I have over 12,000 rows to work with

See More: numbers from one row into seperate rows

September 20, 2010 at 12:34:00
Try this code.

I am making some assumptions:

1 - The input data that you want to rearrange is in Sheet 1
2 - The output can go into Sheet 2
3 - There is nothing in Column C or beyond in Sheet 1.

The code performs a Text-To-Columns operation to separate the data in Column B into individual cells, so you need to have room in Columns C and beyond for the data.

It then counts the data it just separated, row by row, and copies the value from Sheet 1 Column A that many times into Sheet 2 Column A.

Finally, it does a Copy/PasteSpecial-Transpose of the separated data in each row into Column B of Sheet2.

I suggest that you test this code in backup copy of your workbook since macros cannot be undone.

Option Explicit
Sub FancyTranspose()
Dim A_rw, lastA_rw, nxt_rw, Data_cols, rw_Count As Integer
    With Sheets(1)
'Perform TextToColumns operation on Sheet(1) Column B
      .Columns("B:B").TextToColumns Destination:=.Cells(1, 2), _
        DataType:=xlDelimited, Comma:=True
'Initialize Destination Row Variable
         A_rw = 1
'Set Source Row Counter Based On How Many Rows In Column A
          lastA_rw = .Cells(Rows.Count, 1).End(xlUp).Row
'Loop Through Rows
           For nxt_rw = 1 To lastA_rw
'Determine How Many Pieces Of Data In Current Row
            Data_cols = .Cells(nxt_rw, Columns.Count).End(xlToLeft).Column - 1
'Determine Row In Which To Start Next Data Set
            rw_Count = A_rw + Data_cols - 1
'Repeat Column A Value Based On Many Pieces Of Data In Current Row
              Sheets(2).Range(Sheets(2).Cells(A_rw, 1), _
              Sheets(2).Cells(rw_Count, 1)) = .Cells(nxt_rw, 1)
'Copy and PasteSpecial Data (Transposed)
               .Range(.Cells(nxt_rw, 2), .Cells(nxt_rw, Data_cols + 1)).Copy
                  Sheets(2).Cells(A_rw, 2).PasteSpecial Transpose:=True
'Determine Last Row In Sheets(2) Column A
                 A_rw = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
    End With
End Sub

Report •

September 20, 2010 at 16:24:01

Thank you so much for the code!
It worked out exactly as you described and saved me a TON of hours.

You are an Excel genius that's for sure :)

Report •
Related Solutions

Ask Question