Complicated excel transpose

[silverdollar]

Hello,

I have a set of data that contains data using a combination of columns and rows. I would like to transpose the columns into the rows so I would be able to create a load file. I'm not quite sure how to explain this but please see the screen print below to see what I am trying to accomplish. The actual data set has over 200 rows and 200 columns, the end result would have roughly 40,000 (200*200) rows of data. If anyone has a good suggestion on creating this data set, please let me know. I would appreciate any suggestions. Thanks everyone!!

BEFORE:
	Unit A	Unit B	Unit C
GL-1000	100	50	0
GL-1001	200	75	75
GL-2000	300	0	-100
GL-2002	-400	0	100
GL-3000	500	-100	200
GL-3001	600	50	300

<tbody>
</tbody>

<!--[if !mso]><style>v\:* {behavior:url(#default#VML);}o\:* {behavior:url(#default#VML);}x\:* {behavior:url(#default#VML);}.shape {behavior:url(#default#VML);}</style><![endif]-->

AFTER:
Account	Unit	Amount
GL-1000	Unit A	100
GL-1001	Unit A	200
GL-2000	Unit A	300
GL-2002	Unit A	-400
GL-3000	Unit A	500
GL-3001	Unit A	600
GL-1000	Unit B	50
GL-1001	Unit B	75
GL-2000	Unit B	0
GL-2002	Unit B	0
GL-3000	Unit B	-100
GL-3001	Unit B	50
GL-1000	Unit C	0
GL-1001	Unit C	75
GL-2000	Unit C	-100
GL-2002	Unit C	100
GL-3000	Unit C	200
GL-3001	Unit C	300

<tbody>
</tbody>

 

[hiker95]

silverdollar,

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, and, that uses two arrays in memory, and, should be very fast.

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

The macro will create a new worksheet Results.

Sample raw data:

Excel 2007
	A	B	C	D	E
1		Unit A	Unit B	Unit C
2	GL-1000	100	50	0
3	GL-1001	200	75	75
4	GL-2000	300	0	-100
5	GL-2002	-400	0	100
6	GL-3000	500	-100	200
7	GL-3001	600	50	300
8
Sheet1

And, after the macro in worksheet Results:

Excel 2007
	A	B	C
1	Account	Unit	Amount
2	GL-1000	Unit A	100
3	GL-1001	Unit A	200
4	GL-2000	Unit A	300
5	GL-2002	Unit A	-400
6	GL-3000	Unit A	500
7	GL-3001	Unit A	600
8	GL-1000	Unit B	50
9	GL-1001	Unit B	75
10	GL-2000	Unit B	0
11	GL-2002	Unit B	0
12	GL-3000	Unit B	-100
13	GL-3001	Unit B	50
14	GL-1000	Unit C	0
15	GL-1001	Unit C	75
16	GL-2000	Unit C	-100
17	GL-2002	Unit C	100
18	GL-3000	Unit C	200
19	GL-3001	Unit C	300
20
Results

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, 05/11/2017, ME1004903
Dim w1 As Worksheet, wr As Worksheet
Dim lr As Long, lc As Long
Dim a As Variant, i As Long, c As Long, n As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Worksheets("Results")
wr.UsedRange.Clear
With w1
  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.Count(.Range(.Cells(2, 2), .Cells(lr, lc)))
  ReDim o(1 To n + 1, 1 To 3)
  j = j + 1: o(j, 1) = "Account": o(j, 2) = "Unit": o(j, 3) = "Amount"
End With
For c = 2 To UBound(a, 2)
  For i = 2 To UBound(a, 1)
    j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(1, c): o(j, 3) = a(i, c)
  Next i
Next c
With wr
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).Resize(, UBound(o, 2)).AutoFit
  .Activate
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.

 

[silverdollar]

Thank you hiker95!! This works perfectly.

 

[hiker95]

silverdollar,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[Rick Rothstein]

Thank you hiker95!! This works perfectly.

Here is another macro you can consider. There is no speed advantage between hiker95's code and my code, but I did take a different approach with respect to the result sheet. Rather than creating or, if this is run 2 or more, simply clearing the result sheet, I let you specify an empty worksheet to output the results to... that way, you can maintain copies of multiple runs of the program without having to manually transfer the result of one run to a different worksheet before running the program again. The red highlighted rows of code control where to look for the data and where to output the results (the variable names should make it obvious which is which). Anyway, my coding approach is different as well as shorter from hiker95's, so I thought others might find it interesting to dissect if you are into that sort of thing.

[table="width: 500"]
[tr]
	[td]Sub ReorganizeData()
  Dim c As Long, LastRow As Long, LastCol As Long, Data As Variant
  Dim DataSheet As Worksheet, ResultSheet As Worksheet
  Set DataSheet = Sheets("Sheet1")
  Set ResultSheet = Sheets("Sheet2")
  LastRow = DataSheet.Cells(Rows.Count, "A").End(xlUp).Row
  LastCol = DataSheet.Cells(1, Columns.Count).End(xlToLeft).Column
  Application.ScreenUpdating = False
  DataSheet.Cells(2, LastCol + 1).Resize(LastRow - 1, LastCol - 1) = DataSheet.Range("B1").Resize(, LastCol - 1).Value
  Data = Range(DataSheet.Cells(2, "A"), DataSheet.Cells(LastRow, 2 * LastCol - 1))
  ResultSheet.Range("A1:C1") = Array("Account", "Unit", "Amount")
  For c = 2 To LastCol
    ResultSheet.Cells(2 + (c - 2) * UBound(Data), "A").Resize(UBound(Data), 3) = Application.Index(Data, Evaluate("ROW(1:" & LastRow - 1 & ")"), Split("1 " & c + LastCol - 1 & " " & c))
  Next
  ResultSheet.Columns("A").Resize(, LastCol).AutoFit
  DataSheet.Columns(LastCol + 1).Resize(, LastCol).Clear
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[paulsimo0]

I wonder if anybody could please help with a variation on the above query.
My situation is very similar to the one above, but instead of the cells containing numbers, they contain text. I tried the code shown above and although it works perfectly when the cells contain numbers, it reveals an error if I change the details in the cells to text. I have shown a couple of tables below with some sample text to show what I would like. If anybody could help with this, it would be greatly appreciated. The complete table I wish it to work on is much larger than this, but i just wanted to show an example of what I would like to achieve.

Table Before

Name	Colour 1	Colour 2	Colour 3	Colour 4	Colour 5	Colour 6
Fred	Red	Yellow	Green
Joe	Blue	Purple
Bill	Yellow	White	Black	Red
Jane	Purple	Orange	Blue	Red	Green	Yellow
Steve	Purple	Black	Red	Green	White
Henry	Green

<tbody>
</tbody>

Table After

Name	Colour ID	Colour
Fred	Colour 1	Red
Joe	Colour 1	Blue
Bill	Colour 1	Yellow
Jane	Colour 1	Purple
Steve	Colour 1	Purple
Henry	Colour 1	Green
Fred	Colour 2	Yellow
Joe	Colour 2	Purple
Bill	Colour 2	White
Jane	Colour 2	Orange
Steve	Colour 2	Black
Henry	Colour 2
Fred	Colour 3	Green
Joe	Colour 3
Bill	Colour 3	Black
Jane	Colour 3	Blue
Steve	Colour 3	Red
Henry	Colour 3
Fred	Colour 4
Joe	Colour 4
Bill	Colour 4	Red
Jane	Colour 4	Red
Steve	Colour 4	Green
Henry	Colour 4
Fred	Colour 5
Joe	Colour 5
Bill	Colour 5
Jane	Colour 5	Green
Steve	Colour 5	White
Henry	Colour 5
Fred	Colour 6
Joe	Colour 6
Bill	Colour 6
Jane	Colour 6	Yellow
Steve	Colour 6
Henry	Colour 6

<tbody>
</tbody>

Many thanks in anticipation
Paul