Horizontal data to vertical data list

[miky21]

I have a large spreadsheet that has information as follows:

	A	B	C	D	E	D	G
1	Name	Acct
2	Mike	111111111	222222222	333333333
3	Dave	444444444	555555555	666666666	777777777
4	Steve	888888888
5	Sean	999999999	123456789
6	Dana	159753456

<tbody>
</tbody>

and so forth and so on.... note the amount of accounts can very by person to the right of the name.

I'm looking to list the account all in one column with the name of the person on the second column. As follows:

	A	B	C	D	E
1	Name	Acct
2	Mike	111111111
3	Mike	222222222
4	Mike	333333333
5	Dave	444444444
6	Dave	555555555

<tbody>
</tbody>

and so on...

I'm using excel 2010 on windows 7.
Any help would be greatly appreciated.
Thanks

 

[My Aswer Is This]

Miky:
In most cases this is not a good ideal. Spreadsheets typically are designed to be used in such a manner:
Rows are designed to be records
Columns are designed to be used as fields.
Doing as you now plan may run you into problems someday if you want to manipulate your data.

 

[JoeMo]

This will rearrange your data in place assuming the layout you have shown (data start in A1).

Sub RearrangeData()
Dim i As Long, lR As Long, ct As Long, V As Variant, M As Long
Application.ScreenUpdating = False
lR = Range("A" & Rows.Count).End(xlUp).Row
For i = lR To 2 Step -1
    ct = Application.CountA(Range(Cells(i, "A"), Cells(i, "A").End(xlToRight)))
    If ct > 2 Then
        M = Application.Max(M, ct)
        V = Cells(i, "A").Offset(0, 2).Resize(1, ct - 2).Value
        With Cells(i, "A")
            .Offset(1, 0).Resize(ct - 2).EntireRow.Insert
            .Resize(ct - 1, 1).FillDown
            .Resize(ct - 2, 1).Offset(1, 1).Value = Application.Transpose(V)
        End With
    End If
Next i
lR = Range("A" & Rows.Count).End(xlUp).Row
Range(Cells(1, "C"), Cells(lR, M)).ClearContents
Application.ScreenUpdating = True
End Sub

 

[hiker95]

miky21,

Here is another macro solution for you to consider that uses two arrays in memory, and, will adjust to the varying number of raw data rows, and, columns.

And, this will also rearrange your data in place assuming the layout you have shown (data start in A1).

You can change the raw data worksheet name in the macro.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData()
' hiker95, 07/22/2015, ME870183
Dim a As Variant, o As Variant, i As Long, j As Long, lR As Long, lc As Long, n As Long, c As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lR = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  a = .Range(.Cells(2, 1), .Cells(lR, lc))
  n = Application.CountA(.Range(.Cells(2, 2), .Cells(lR, lc)))
  ReDim o(1 To n, 1 To 2)
  For i = LBound(a, 1) To UBound(a, 1)
    For c = 2 To UBound(a, 2)
      If Not a(i, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, c)
      End If
    Next c
  Next i
  .Range(.Cells(2, 1), .Cells(lR, lc)).ClearContents
  .Cells(2, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData macro.