Stack data in multiple columns into one but carry over row headers

[ezpzspreadsheets]

I have an array of a sales report that was a .csv. I ran the text to columns and am left with this. I named the data set A2:F6 as "MYDATA"

	A	B	C	D	E	F
1	Name	Item	Item	Item	Item	Item
2	Jane	Shirt	Leggings	Dress
3	Sallie	Dress
4	Edith	Leggings	Skirt
5	Cora	Leggings
6	Sallie	Skirt	Dress	Dress	Leggings	Shirt

<tbody>
</tbody>

I want the data to look like this

	A	B
1	Name	Item
2	Jane	Shirt
3	Jane	Leggings
4	Jane	Dress
5	Sallie	Dress
6	Edith	Leggings
7	Edith	Skirt
8	Cora	Leggings
9	Sallie	Skirt
10	Sallie	Dress
11	Sallie	Dress
12	Sallie	Leggings
13	Sallie	Shirt

<tbody>
</tbody>

I've tried

INDEX(MyData,1+INT((ROW(A1)-1)/COLUMNS(MyData)),MOD(ROW(A1)-1+COLUMNS(MyData),COLUMNS(MyData))+1)

to get the ITEM in one column, but am not sure how to carry over the Header information (names) in column A. Thanks in advance.

 

[footoo]

Here's a macro :

Sub v()
Dim nme As Range, cel As Range, rw%, itm As Range
Set nme = Range([A2], Cells(Rows.Count, "A").End(xlUp))
Application.ScreenUpdating = False
For Each cel In nme
    rw = Cells(Rows.Count, "A").End(xlUp)(2).Row
    Set itm = Range(Cells(cel.Row, "B"), Cells(cel.Row, Columns.Count).End(xlToLeft))
    cel.Copy Cells(rw, "A").Resize(itm.Cells.Count)
    Cells(rw, "B").Resize(itm.Cells.Count) = Application.Transpose(itm)
Next
Range([C1], Cells(1, Columns.Count).End(xlToLeft)).ClearContents
nme.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

 

[hiker95]

ezpzspreadsheets,

Welcome to the MrExcel forum.

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

The original raw data in Range(A1:F6) will be removed, and, the results will be written to Range(A1:B13).

If you want the results to be written to the right of he raw data, then I can adjust 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 ReorganizeData()
' hiker95, 12/17/2017, ME1035652
Dim a As Variant, lr As Long, lc As Long, n As Long, r As Long, c As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells(.Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = Application.CountA(.Range(.Cells(2, 2), .Cells(lr, lc))) + 1
  ReDim o(1 To n, 1 To 2)
  j = j + 1: o(j, 1) = "Name": o(j, 2) = "Item"
  For r = 2 To lr
    For c = 2 To lc
      If Not a(r, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(r, 1)
        o(j, 2) = a(r, c)
      End If
    Next c
  Next r
  .Range(.Cells(1, 1), .Cells(lr, lc)).ClearContents
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .UsedRange.Columns.AutoFit
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 ReorganizeData macro.

 

[hiker95]

ezpzspreadsheets,

Here is a macro that will write the results to the third column to the right of the last used raw data column.

Sub ReorganizeData_V2()
Dim a As Variant, lr As Long, lc As Long, n As Long, r As Long, c As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells(.Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = Application.CountA(.Range(.Cells(2, 2), .Cells(lr, lc))) + 1
  ReDim o(1 To n, 1 To 2)
  j = j + 1: o(j, 1) = "Name": o(j, 2) = "Item"
  For r = 2 To lr
    For c = 2 To lc
      If Not a(r, c) = vbEmpty Then
        j = j + 1: o(j, 1) = a(r, 1)
        o(j, 2) = a(r, c)
      End If
    Next c
  Next r
  .Cells(1, lc + 3).Resize(UBound(o, 1), UBound(o, 2)) = o
  .UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

 

[ezpzspreadsheets]

Thank you!

Question... what would be the modification to make if there were multiple "header" rows to carry over... example: Name in column A, Date in Column B, Order Number in Column C, then Items in columns D through H.

 

[hiker95]

Thank you!

ezpzspreadsheets,

You are very welcome. Glad I could help.

 

[hiker95]

Question... what would be the modification to make if there were multiple "header" rows to carry over... example: Name in column A, Date in Column B, Order Number in Column C, then Items in columns D through H.

ezpzspreadsheets,

Can we have two more flat text displays (based on the above quote), like your original reply #1?