Reorganize Excel Sheet Quickly (Large Transpose)

[wenyusa]

In my excel sheet, each location is a row and each column is a year/month. The values are the revenue for the location by month.

Instead I need it to duplicate each row, with each location row having the year/month and revenue included. For example, the current layout is as follows going out for all 12 months:

State	Location	2015/01	2015/02
NY	ABC	100	150
NY	XYZ	125	175
CT	QRS	75	150
MD	LMN	100	125
NJ	DEF	150	200

<tbody>
</tbody>

I want it to be in the following layout:

State	Location	Date	Expected Revenue
NY	ABC	2015/01	100
NY	ABC	2015/02	150
NY	XYZ	2015/01	125
NY	XYZ	2015/02	175

<tbody>
</tbody>

Doing this would allow me to create the pivots and do additional analysis necessary. There are over 100 locations with 12 months of data. I have experimented and adding 12 lines and transposing the data is too time consuming.

Any tricks/tips to get this accomplished?

Thanks!

 

[hiker95]

wenyusa,

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?

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

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

Sample raw data:

Excel 2007
	A	B	C	D	E
1	State	Location	2015/01	2015/02
2	NY	ABC	100	150
3	NY	XYZ	125	175
4	CT	QRS	75	150
5	MD	LMN	100	125
6	NJ	DEF	150	200
7
Sheet1

After the macro in a new worksheet Results:

Excel 2007
	A	B	C	D
1	State	Location	Date	Expected Refenue
2	NY	ABC	2015/01	100
3	NY	ABC	2015/02	150
4	NY	XYZ	2015/01	125
5	NY	XYZ	2015/02	175
6	CT	QRS	2015/01	75
7	CT	QRS	2015/02	150
8	MD	LMN	2015/01	100
9	MD	LMN	2015/02	125
10	NJ	DEF	2015/01	150
11	NJ	DEF	2015/02	200
12
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 ReorgData()
' hiker95, 06/09/2015
Dim w1 As Worksheet, wr As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long, lr As Long, lc As Long, c As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
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))
  ReDim o(1 To ((lr - 1) * (lc - 2)) + 1, 1 To 4)
End With
j = j + 1: o(j, 1) = "State": o(j, 2) = "Location": o(j, 3) = "Date": o(j, 4) = "Expected Refenue"
For i = 2 To UBound(a, 1)
  For c = 3 To UBound(a, 2)
    j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, 2): o(j, 3) = a(1, c): o(j, 4) = a(i, c)
  Next c
Next i
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
With wr
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns("A:D").AutoFit
  .Activate
End With
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.

 

[wenyusa]

I am using Excel 2010 on a PC.

This is great! Seems to work, but I have a few extra columns that I need to incorporate into this which the macro kicks out...

Column 1(A) = State
Column 2(B) = Location 1
Column 3(C) = Location 2
Column 4(D) = Location 3

Then it should create the date and transpose the expected revenue. How can I update this code to do this?

Otherwise it seems to be working right.

wenyusa,

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?

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

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

Sample raw data:

Excel 2007

	A	B	C	D	E
1	State	Location	2015/01	2015/02
2	NY	ABC	100	150
3	NY	XYZ	125	175
4	CT	QRS	75	150
5	MD	LMN	100	125
6	NJ	DEF	150	200
7

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

After the macro in a new worksheet Results:

Excel 2007

	A	B	C	D
1	State	Location	Date	Expected Refenue
2	NY	ABC	2015/01	100
3	NY	ABC	2015/02	150
4	NY	XYZ	2015/01	125
5	NY	XYZ	2015/02	175
6	CT	QRS	2015/01	75
7	CT	QRS	2015/02	150
8	MD	LMN	2015/01	100
9	MD	LMN	2015/02	125
10	NJ	DEF	2015/01	150
11	NJ	DEF	2015/02	200
12

<colgroup><col style="width: 25pxpx"><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

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 ReorgData()
' hiker95, 06/09/2015
Dim w1 As Worksheet, wr As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long, lr As Long, lc As Long, c As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
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))
  ReDim o(1 To ((lr - 1) * (lc - 2)) + 1, 1 To 4)
End With
j = j + 1: o(j, 1) = "State": o(j, 2) = "Location": o(j, 3) = "Date": o(j, 4) = "Expected Refenue"
For i = 2 To UBound(a, 1)
  For c = 3 To UBound(a, 2)
    j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, 2): o(j, 3) = a(1, c): o(j, 4) = a(i, c)
  Next c
Next i
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
With wr
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns("A:D").AutoFit
  .Activate
End With
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.

 

[hiker95]

wenyusa,

Unless there is a particular reason to do so, it is best not to quote whole long replies like you did with mine. It makes the thread harder to navigate/read and just takes up unnecessary space.

1. Quote ONLY if it is needed to add clarity or context for your reply. If so, then
2. Quote ONLY the specific part of the post that is relevant - - not the entire post.

This will keep thread clutter to a minimum and make the discussion easier to follow.

This is great! Seems to work, but I have a few extra columns that I need to incorporate into this which the macro kicks out...

It is always best to display your actual raw data worksheet(s), and, the results that you are looking for. This way we can usually find a solution on the first go.

So that we can get it right on the next try:

Can you post a screenshot of the actual raw data worksheet?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post a small screen shot (NOT a graphic, or, picture, or, flat text) try one of the following:

MrExcel HTML Maker
If you do not know how to install and how to use HTML Mr.Excel Maker
https://www.youtube.com/watch?v=JycvgGppxt0&feature=youtu.be

Excel Jeanie
Download

Borders-Copy-Paste
http://www.mrexcel.com/forum/about-board/444901-how-create-table-like-aladin.html#post2198045

To test the above:
Test Here


Or, you can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[wenyusa]

I apologize about that.

I have saved it into my dropbox. The before sheet shows the current layout. The After sheet shows How I would like it to look. I changed all the data including the header names, so i would need the macro either to pull the header names or allow me to hardcode the names in the coding area.

There would also be a lot more rows of data than what is shown (in the 100's or maybe the 1,000's but not the 10,000's)

I hope this helps, and sorry about the last post.

https://www.dropbox.com/s/rfg288odxfky78u/Macro Transpose Test.xlsx?dl=0

 

[hiker95]

wenyusa,

Thanks for the workbook.

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

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

i would need the macro either to pull the header names or allow me to hardcode the names in the coding area

You will be able to change/hardcode the 6 output header names 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).

Sub ReorgDataV2()
' hiker95, 06/09/2015
Dim w1 As Worksheet, wr As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long, lr As Long, lc As Long, c As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
With w1
  If .FilterMode = True Then .ShowAllData
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  ReDim o(1 To ((lr - 1) * (lc - 4)) + 1, 1 To 6)
End With
j = j + 1
o(j, 1) = "Chg Database(State)"
o(j, 2) = "Location 1"
o(j, 3) = "Location 2"
o(j, 4) = "Location 3"
o(j, 5) = "Date"
o(j, 6) = "Expected Revenue"
For i = 2 To UBound(a, 1)
  For c = 5 To UBound(a, 2)
    j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, 2): o(j, 3) = a(i, 3)
    o(j, 4) = a(i, 4): o(j, 5) = a(1, c): o(j, 6) = a(i, c)
  Next c
Next i
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
With wr
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  With .Cells(1, 1).Resize(, 6)
    .HorizontalAlignment = xlCenter
    .Font.Name = "MS Sans Serif"
    .Font.FontStyle = "Bold"
    .Font.Size = 8.5
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).ColorIndex = 0
    .Borders(xlEdgeBottom).TintAndShade = 0
    .Borders(xlEdgeBottom).Weight = xlMedium
  End With
  With .Range("F2:F" & UBound(o, 1))
    .NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""??_);_(@_)"
    .Font.Name = "Arial"
    .Font.FontStyle = "Regular"
    .Font.Size = 10
    .Font.ThemeColor = xlThemeColorLight1
    .Font.TintAndShade = 0
  End With
  .Columns("A:F").AutoFit
  .Activate
End With
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 ReorgDataV2 macro.

 

[wenyusa]

This works perfect! Exactly what I needed! Thank you very much! I'll have to walk through slowly and try to understand what you did but this is great! Thanks again!

 

[hiker95]

wenyusa,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.