Reputation: 1624
I have a code that crashes my excel, it takes the data from one sheet and transforms it from a tabular view to vertical. I believe it is slow because it is taking it from a database view to over 45k rows.
does anyone have any tips for optimizing this code? Crashes my excel at the next c
loop
Also I tried running this in excel 2010, get an overflow
error, but usually 2010 runs better and 2013 is slow or not responding. But I want to get it working for 2013.
Sub test()
Call ReversePivotTable("Sheet1", "A", "C", "Sheet2", "Name")
End Sub
Sub ReversePivotTable(source_sheet, from_col, to_col, target_sheet, Optional type_header = "type", Optional value_header = "value")
Application.ScreenUpdating = False
LAST_ROW = Sheets(source_sheet).Cells(Rows.count, 1).End(xlUp).Row
If LAST_ROW > 1 Then
Sheets(target_sheet).Cells.ClearContents
Else
Exit Sub
End If
pvt_type_col = Sheets(target_sheet).Range(to_col & 1).Offset(0, 1).column 'D
pvt_value_col = Sheets(target_sheet).Range(to_col & 1).Offset(0, 2).column 'E
'get headers
Sheets(source_sheet).Range(from_col & ":" & to_col).copy
Sheets(target_sheet).Range("A1").PasteSpecial xlPasteValues
Sheets(target_sheet).Cells(1, pvt_type_col).Value = type_header
Sheets(target_sheet).Cells(1, pvt_value_col).Value = value_header
'tranform data
curr_row = 2
With Sheets(source_sheet)
last_col = .Cells(1, Columns.count).End(xlToLeft).column
For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
Set rng = .Range(.Cells(c.Row, pvt_type_col), .Cells(c.Row, last_col))
numbers = Application.WorksheetFunction.CountIf(rng, "<>""")
If numbers > 0 Then
Sheets(source_sheet).Range(from_col & c.Row & ":" & to_col & c.Row).copy
Sheets(target_sheet).Range(from_col & curr_row & ":" & from_col & curr_row + numbers - 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
b = curr_row
For a = pvt_type_col To last_col Step 1
If IsNumeric(.Cells(c.Row, a).Value) Then
'If .Cells(c.Row, a).Value <> "" Then
Sheets(target_sheet).Cells(b, pvt_type_col) = .Cells(1, a)
Sheets(target_sheet).Cells(b, pvt_value_col) = .Cells(c.Row, a)
b = b + 1
End If
Next a
curr_row = curr_row + numbers
If curr_row Mod 10 = 0 Then DoEvents
End If
Next c
End With
Sheets(target_sheet).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Adding sample data, before:
+---------+------------------+-----------------+--------------+-------------+--------------+-------------+--------------+--------------+-------------+-------------+-------------+--------------+--------------+-------------+-------------+--------+--------+--------+--------------+--------------+-------------+--------------+-------------+-------------+-------------+-------------+--------------+-------------+--------------+-------------+--------------+-------------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+
| col 1 | col 2 | col 3 | col 4 | col 5 | col 6 | col 7 | col 8 | col 9 | col 10 | col 11 | col 12 | col 13 | col 14 | col 15 | col 16 | col 17 | col 18 | col 19 | col 20 | col 21 | col 22 | col 23 | col 24 | col 25 | col 26 | col 27 | col 28 | col 29 | col 30 | col 31 | col 32 | col 33 | col 34 | col 35 | col 36 | col 37 | col 38 | col 39 | col 40 | col 41 | col 42 | col 43 | col 44 | col 45 | col 46 | col 47 | col 48 | col 49 |
+---------+------------------+-----------------+--------------+-------------+--------------+-------------+--------------+--------------+-------------+-------------+-------------+--------------+--------------+-------------+-------------+--------+--------+--------+--------------+--------------+-------------+--------------+-------------+-------------+-------------+-------------+--------------+-------------+--------------+-------------+--------------+-------------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+
| stack | questions forums | excel questions | -540.0689323 | 1543.570725 | -144.7954348 | 2298.261951 | -9019.970702 | -14669.27805 | 2400.31011 | 642.2459256 | 5573.176935 | -19167.60096 | -17070.78503 | 2884.343252 | 2262.2904 | 0 | 0 | 0 | -4866.524221 | -5470.616311 | 6722.889306 | -6749.153327 | 8483.707603 | 7513.052842 | 3768.659869 | 8600.703543 | -8642.799155 | 1322.251923 | -1323.911031 | 3651.739593 | -259.3401823 | 9369.890794 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| stack | questions forums | excel questions | -325.5117945 | 641.8568521 | -58.21010305 | 977.4626836 | -3505.695779 | -7455.410001 | 777.9341271 | 385.2714806 | 1932.531773 | -8861.136183 | -6679.463121 | 1177.775583 | 881.2548725 | 0 | 0 | 0 | -1813.822794 | -2266.860562 | 2278.669772 | -2361.758467 | 3356.446385 | 2741.992369 | 1461.950204 | 3289.154294 | -3469.10217 | 804.7989704 | -816.9003551 | 1907.515323 | 432.8435868 | 3074.256129 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| stack | questions forums | excel questions | -36.42618332 | 65.26139258 | -6.513963305 | 99.38442773 | -435.0485137 | -1047.099199 | 79.09717611 | 39.17283622 | 186.7060257 | -1272.372107 | -922.750792 | 118.3261869 | 89.60240903 | 0 | 0 | 0 | -210.3183182 | -267.1376584 | 214.6223869 | -280.0000537 | 293.4738136 | 248.5196226 | 144.0720039 | 288.5506437 | -430.0886416 | 81.82868405 | -91.41469707 | 184.4395708 | 44.00977438 | 272.8284368 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| stack | questions forums | excel questions | -582.3647427 | 1316.573479 | -165.4555206 | 1925.519573 | -7138.977944 | -17532.94829 | 1404.004642 | 930.6126154 | 3648.013625 | -19585.55834 | -13758.8035 | 2376.319408 | 1898.9449 | 0 | 0 | 0 | -3625.886962 | -4833.808881 | 4232.764078 | -4449.956081 | 6883.584715 | 5398.12044 | 4048.773452 | 6632.405148 | -7240.871663 | 1959.676076 | -2008.657583 | 4413.431721 | 1360.661107 | 5484.849776 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
+---------+------------------+-----------------+--------------+-------------+--------------+-------------+--------------+--------------+-------------+-------------+-------------+--------------+--------------+-------------+-------------+--------+--------+--------+--------------+--------------+-------------+--------------+-------------+-------------+-------------+-------------+--------------+-------------+--------------+-------------+--------------+-------------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+
desired after:
+---------+------------------+-----------------+-----------+--------------+
| col 1 | col 2 | col 3 | Attribute | Value |
+---------+------------------+-----------------+-----------+--------------+
| stack | questions forums | excel questions | col 4 | -540.0689323 |
| stack | questions forums | excel questions | col 5 | 1543.570725 |
| stack | questions forums | excel questions | col 6 | -144.7954348 |
| stack | questions forums | excel questions | col 7 | 2298.261951 |
| stack | questions forums | excel questions | col 8 | -9019.970702 |
| stack | questions forums | excel questions | col 9 | -14669.27805 |
| stack | questions forums | excel questions | col 10 | 2400.31011 |
| stack | questions forums | excel questions | col 11 | 642.2459256 |
| stack | questions forums | excel questions | col 12 | 5573.176935 |
| stack | questions forums | excel questions | col 13 | -19167.60096 |
| stack | questions forums | excel questions | col 14 | -17070.78503 |
| stack | questions forums | excel questions | col 15 | 2884.343252 |
| stack | questions forums | excel questions | col 16 | 2262.2904 |
| stack | questions forums | excel questions | col 17 | 0 |
| stack | questions forums | excel questions | col 18 | 0 |
| stack | questions forums | excel questions | col 19 | 0 |
| stack | questions forums | excel questions | col 20 | -4866.524221 |
| stack | questions forums | excel questions | col 21 | -5470.616311 |
| stack | questions forums | excel questions | col 22 | 6722.889306 |
| stack | questions forums | excel questions | col 23 | -6749.153327 |
| stack | questions forums | excel questions | col 24 | 8483.707603 |
| stack | questions forums | excel questions | col 25 | 7513.052842 |
| stack | questions forums | excel questions | col 26 | 3768.659869 |
| stack | questions forums | excel questions | col 27 | 8600.703543 |
| stack | questions forums | excel questions | col 28 | -8642.799155 |
| stack | questions forums | excel questions | col 29 | 1322.251923 |
| stack | questions forums | excel questions | col 30 | -1323.911031 |
| stack | questions forums | excel questions | col 31 | 3651.739593 |
| stack | questions forums | excel questions | col 32 | -259.3401823 |
| stack | questions forums | excel questions | col 33 | 9369.890794 |
| stack | questions forums | excel questions | col 34 | 0 |
| stack | questions forums | excel questions | col 35 | 0 |
| stack | questions forums | excel questions | col 36 | 0 |
| stack | questions forums | excel questions | col 37 | 0 |
| stack | questions forums | excel questions | col 38 | 0 |
| stack | questions forums | excel questions | col 39 | 0 |
| stack | questions forums | excel questions | col 40 | 0 |
| stack | questions forums | excel questions | col 41 | 0 |
| stack | questions forums | excel questions | col 42 | 0 |
| stack | questions forums | excel questions | col 43 | 0 |
| stack | questions forums | excel questions | col 44 | 0 |
| stack | questions forums | excel questions | col 45 | 0 |
| stack | questions forums | excel questions | col 46 | 0 |
| stack | questions forums | excel questions | col 47 | 0 |
| stack | questions forums | excel questions | col 48 | 0 |
| stack | questions forums | excel questions | col 49 | 0 |
| stack | questions forums | excel questions | col 4 | -325.5117945 |
| stack | questions forums | excel questions | col 5 | 641.8568521 |
| stack | questions forums | excel questions | col 6 | -58.21010305 |
| stack | questions forums | excel questions | col 7 | 977.4626836 |
| stack | questions forums | excel questions | col 8 | -3505.695779 |
| stack | questions forums | excel questions | col 9 | -7455.410001 |
| stack | questions forums | excel questions | col 10 | 777.9341271 |
| stack | questions forums | excel questions | col 11 | 385.2714806 |
| stack | questions forums | excel questions | col 12 | 1932.531773 |
| stack | questions forums | excel questions | col 13 | -8861.136183 |
| stack | questions forums | excel questions | col 14 | -6679.463121 |
| stack | questions forums | excel questions | col 15 | 1177.775583 |
| stack | questions forums | excel questions | col 16 | 881.2548725 |
| stack | questions forums | excel questions | col 17 | 0 |
| stack | questions forums | excel questions | col 18 | 0 |
| stack | questions forums | excel questions | col 19 | 0 |
| stack | questions forums | excel questions | col 20 | -1813.822794 |
| stack | questions forums | excel questions | col 21 | -2266.860562 |
| stack | questions forums | excel questions | col 22 | 2278.669772 |
| stack | questions forums | excel questions | col 23 | -2361.758467 |
| stack | questions forums | excel questions | col 24 | 3356.446385 |
| stack | questions forums | excel questions | col 25 | 2741.992369 |
| stack | questions forums | excel questions | col 26 | 1461.950204 |
| stack | questions forums | excel questions | col 27 | 3289.154294 |
| stack | questions forums | excel questions | col 28 | -3469.10217 |
| stack | questions forums | excel questions | col 29 | 804.7989704 |
| stack | questions forums | excel questions | col 30 | -816.9003551 |
| stack | questions forums | excel questions | col 31 | 1907.515323 |
| stack | questions forums | excel questions | col 32 | 432.8435868 |
| stack | questions forums | excel questions | col 33 | 3074.256129 |
| stack | questions forums | excel questions | col 34 | 0 |
| stack | questions forums | excel questions | col 35 | 0 |
| stack | questions forums | excel questions | col 36 | 0 |
| stack | questions forums | excel questions | col 37 | 0 |
| stack | questions forums | excel questions | col 38 | 0 |
| stack | questions forums | excel questions | col 39 | 0 |
| stack | questions forums | excel questions | col 40 | 0 |
| stack | questions forums | excel questions | col 41 | 0 |
| stack | questions forums | excel questions | col 42 | 0 |
| stack | questions forums | excel questions | col 43 | 0 |
| stack | questions forums | excel questions | col 44 | 0 |
| stack | questions forums | excel questions | col 45 | 0 |
| stack | questions forums | excel questions | col 46 | 0 |
| stack | questions forums | excel questions | col 47 | 0 |
| stack | questions forums | excel questions | col 48 | 0 |
| stack | questions forums | excel questions | col 49 | 0 |
| stack | questions forums | excel questions | col 4 | -36.42618332 |
| stack | questions forums | excel questions | col 5 | 65.26139258 |
| stack | questions forums | excel questions | col 6 | -6.513963305 |
| stack | questions forums | excel questions | col 7 | 99.38442773 |
| stack | questions forums | excel questions | col 8 | -435.0485137 |
| stack | questions forums | excel questions | col 9 | -1047.099199 |
| stack | questions forums | excel questions | col 10 | 79.09717611 |
| stack | questions forums | excel questions | col 11 | 39.17283622 |
| stack | questions forums | excel questions | col 12 | 186.7060257 |
| stack | questions forums | excel questions | col 13 | -1272.372107 |
| stack | questions forums | excel questions | col 14 | -922.750792 |
| stack | questions forums | excel questions | col 15 | 118.3261869 |
| stack | questions forums | excel questions | col 16 | 89.60240903 |
| stack | questions forums | excel questions | col 17 | 0 |
| stack | questions forums | excel questions | col 18 | 0 |
| stack | questions forums | excel questions | col 19 | 0 |
| stack | questions forums | excel questions | col 20 | -210.3183182 |
| stack | questions forums | excel questions | col 21 | -267.1376584 |
| stack | questions forums | excel questions | col 22 | 214.6223869 |
| stack | questions forums | excel questions | col 23 | -280.0000537 |
| stack | questions forums | excel questions | col 24 | 293.4738136 |
| stack | questions forums | excel questions | col 25 | 248.5196226 |
| stack | questions forums | excel questions | col 26 | 144.0720039 |
| stack | questions forums | excel questions | col 27 | 288.5506437 |
| stack | questions forums | excel questions | col 28 | -430.0886416 |
| stack | questions forums | excel questions | col 29 | 81.82868405 |
| stack | questions forums | excel questions | col 30 | -91.41469707 |
| stack | questions forums | excel questions | col 31 | 184.4395708 |
| stack | questions forums | excel questions | col 32 | 44.00977438 |
| stack | questions forums | excel questions | col 33 | 272.8284368 |
| stack | questions forums | excel questions | col 34 | 0 |
| stack | questions forums | excel questions | col 35 | 0 |
| stack | questions forums | excel questions | col 36 | 0 |
| stack | questions forums | excel questions | col 37 | 0 |
| stack | questions forums | excel questions | col 38 | 0 |
| stack | questions forums | excel questions | col 39 | 0 |
| stack | questions forums | excel questions | col 40 | 0 |
| stack | questions forums | excel questions | col 41 | 0 |
| stack | questions forums | excel questions | col 42 | 0 |
| stack | questions forums | excel questions | col 43 | 0 |
| stack | questions forums | excel questions | col 44 | 0 |
| stack | questions forums | excel questions | col 45 | 0 |
| stack | questions forums | excel questions | col 46 | 0 |
| stack | questions forums | excel questions | col 47 | 0 |
| stack | questions forums | excel questions | col 48 | 0 |
| stack | questions forums | excel questions | col 49 | 0 |
| stack | questions forums | excel questions | col 4 | -582.3647427 |
| stack | questions forums | excel questions | col 5 | 1316.573479 |
| stack | questions forums | excel questions | col 6 | -165.4555206 |
| stack | questions forums | excel questions | col 7 | 1925.519573 |
| stack | questions forums | excel questions | col 8 | -7138.977944 |
| stack | questions forums | excel questions | col 9 | -17532.94829 |
| stack | questions forums | excel questions | col 10 | 1404.004642 |
| stack | questions forums | excel questions | col 11 | 930.6126154 |
| stack | questions forums | excel questions | col 12 | 3648.013625 |
| stack | questions forums | excel questions | col 13 | -19585.55834 |
| stack | questions forums | excel questions | col 14 | -13758.8035 |
| stack | questions forums | excel questions | col 15 | 2376.319408 |
| stack | questions forums | excel questions | col 16 | 1898.9449 |
| stack | questions forums | excel questions | col 17 | 0 |
| stack | questions forums | excel questions | col 18 | 0 |
| stack | questions forums | excel questions | col 19 | 0 |
| stack | questions forums | excel questions | col 20 | -3625.886962 |
| stack | questions forums | excel questions | col 21 | -4833.808881 |
| stack | questions forums | excel questions | col 22 | 4232.764078 |
| stack | questions forums | excel questions | col 23 | -4449.956081 |
| stack | questions forums | excel questions | col 24 | 6883.584715 |
| stack | questions forums | excel questions | col 25 | 5398.12044 |
| stack | questions forums | excel questions | col 26 | 4048.773452 |
| stack | questions forums | excel questions | col 27 | 6632.405148 |
| stack | questions forums | excel questions | col 28 | -7240.871663 |
| stack | questions forums | excel questions | col 29 | 1959.676076 |
| stack | questions forums | excel questions | col 30 | -2008.657583 |
| stack | questions forums | excel questions | col 31 | 4413.431721 |
| stack | questions forums | excel questions | col 32 | 1360.661107 |
| stack | questions forums | excel questions | col 33 | 5484.849776 |
| stack | questions forums | excel questions | col 34 | 0 |
| stack | questions forums | excel questions | col 35 | 0 |
| stack | questions forums | excel questions | col 36 | 0 |
| stack | questions forums | excel questions | col 37 | 0 |
| stack | questions forums | excel questions | col 38 | 0 |
| stack | questions forums | excel questions | col 39 | 0 |
| stack | questions forums | excel questions | col 40 | 0 |
| stack | questions forums | excel questions | col 41 | 0 |
| stack | questions forums | excel questions | col 42 | 0 |
| stack | questions forums | excel questions | col 43 | 0 |
| stack | questions forums | excel questions | col 44 | 0 |
| stack | questions forums | excel questions | col 45 | 0 |
| stack | questions forums | excel questions | col 46 | 0 |
| stack | questions forums | excel questions | col 47 | 0 |
| stack | questions forums | excel questions | col 48 | 0 |
| stack | questions forums | excel questions | col 49 | 0 |
+---------+------------------+-----------------+-----------+--------------+
Upvotes: 3
Views: 450
Reputation: 8591
Sorry, but i don't want to analyse your code and even use it for set of reasons...
First of all, a common error within VBA programming is to used unspecified (undeclared) variables. This causes several issues, especially when a programmer have made a spelling mistake (typing error), for example instead of myvariable
he used myvairable
. So...
It's strongly recommended to use Option Explicit statement, because... as MSDN documentation states:
If you do not specify a data type, the
Variant
data type is assigned by default.(...)
Variables of type
Variant
require more memory resources than most other variables(...)
If a module includes the
Option Explicit
statement, a compile-time error will occur when Visual Basic encounters a variable name that has not been previously declared, or that has been spelled incorrectly.
For further details, please see:
Wikipedia: Visual Basic for Applications
VBA: Declaring Variables
Runtime vs Compile time
Office Talk: Working with VBA in the 32-bit and 64-bit Versions of Office 2010
Second of all, an Overflow error occurs when you try to make an assignment that exceeds the limitations of the target of the assignment. That error might be the reason of Excel crush.
Third of all, you should use code in context. Un-contextual usage of code might be the reason of several issues, such as loss of data.
Imagine: there are 2 opened workbooks. Both of them have the same set of sheets: Sheet1
, Sheet2
and Sheet3
. When you use Sheets("Sheet1").Range("A1") = "whatever"
changes are made in active workbook, let's say Workbook1
, but you wanted to make changes in Workbook2
. Got it?
BTW: note, that Sheet
is not the same as Worksheet
Sheets vs. Worksheets
So, a proper way to use code-in-context is:
Dim srcWsh As Worksheet
Dim trgWsh As Worksheet
Set srcWsh = ThisWorkbook.Worksheets("Sheet1") 'you can use index too, see:
Set trgWsh = Workbooks("Workbook2").Worksheets(2)
trgWsh.Range("A1") = srcWsh.Range("A1")
'finally, you have to clean up
Set srcWsh = Nothing
Set trgWsh = Nothing
The same rules have to be used when you create or call procedure or function
Finally...
As to the method to reverse (unpivot) data...
I did use an example from MSDN: Using PIVOT and UNPIVOT, where these data:
VendorID Emp1 Emp2 Emp3 Emp4 Emp5
1 4 3 5 4 4
2 4 1 5 5 5
3 4 3 5 4 4
4 4 2 5 5 4
5 5 1 5 5 5
have to be "converted" into this form:
VendorID Employee Orders
----------- ----------- ------
1 Emp1 4
1 Emp2 3
1 Emp3 5
1 Emp4 4
1 Emp5 4
2 Emp1 4
2 Emp2 1
2 Emp3 5
2 Emp4 5
2 Emp5 5
...
My code:
Option Explicit
Sub Test()
UnpivotData ThisWorkbook.Worksheets("Arkusz1"), _
ThisWorkbook.Worksheets("Arkusz2"), _
"A1", "B1:F1"
End Sub
Sub UnpivotData(ByVal srcWsh As Worksheet, ByVal trgWsh As Worksheet, ByVal unpvtFor As String, ByVal pivotedColumns As String, _
Optional ByVal commonHeader As String = "Employee", Optional ByVal pvtValuesToCol As String = "Orders")
'declare variables
Dim lastrow As Long, r As Long, trgr As Long
Dim c As Long, cName As String
'on error go to error handler
On Error GoTo Err_UnpivotData
'find last row
lastrow = srcWsh.UsedRange.Rows.Count
'context!
With trgWsh
'clear
.Cells.Clear
'add headers
.Range("A1") = srcWsh.Range(unpvtFor)
.Range("B1") = commonHeader
.Range("C1") = pvtValuesToCol
'"convert" values
r = 1
trgr = 0
'loop through the collection of rows in srcWsh
Do While r < lastrow
'loop through the collection of pivoted columns in srcWsh
For c = 0 To srcWsh.Range(pivotedColumns).Columns.Count - 1
'unpivot value of 1. column
.Range("A2").Offset(RowOffset:=trgr, ColumnOffset:=0) = srcWsh.Range(unpvtFor).Offset(RowOffset:=r, ColumnOffset:=0)
'unpivot header
cName = srcWsh.Range(pivotedColumns).Columns(c + 1).Address
.Range("A2").Offset(RowOffset:=trgr, ColumnOffset:=1) = srcWsh.Range(cName).Rows(1)
'unpivot value
.Range("A2").Offset(RowOffset:=trgr, ColumnOffset:=2) = srcWsh.Range(unpvtFor).Offset(RowOffset:=r, ColumnOffset:=c + 1)
'increase target counter
trgr = trgr + 1
Next
'increase source counter
r = r + 1
Loop
End With
Exit_UnpivotData:
On Error Resume Next
'clean up
Exit Sub
Err_UnpivotData:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_UnpivotData
End Sub
Feel free to change it to your needs...
Working example: Unpivot.7z - available to download between 7:01AM and 11:59PM Central Europe (Warsaw) Time
I hope i've explained in details what's wrong with your code.
[EDIT]
Assuming that data are in Sheet1
and target sheet is Sheet2
...
Option Explicit
Sub Test()
UnpivotData ThisWorkbook.Worksheets("Sheet1"), _
ThisWorkbook.Worksheets("Sheet2"), _
"A1:C1", "D1:AW1"
End Sub
Sub UnpivotData(ByVal srcWsh As Worksheet, ByVal trgWsh As Worksheet, ByVal unpvtFor As String, ByVal pivotedColumns As String, _
Optional ByVal commonHeader As String = "Attribute", Optional ByVal pvtValuesToCol As String = "Value")
'declare variables
Dim lastrow As Long, r As Long, trgr As Long
Dim c As Long, cName As String
Dim cc As Range
'on error go to error handler
On Error GoTo Err_UnpivotData
'change settings to improve speed of macro executing
Application.EnableEvents = False
Application.ScreenUpdating = False
'find last row
lastrow = srcWsh.UsedRange.Rows.Count
'context!
With trgWsh
'clear
.Cells.Clear
'add headers
For Each cc In srcWsh.Range(unpvtFor).Cells
.Range("A1").Offset(ColumnOffset:=c) = Trim(cc)
c = c + 1
Next
Set cc = .Range("A2").Offset(ColumnOffset:=c)
.Range("A1").Offset(ColumnOffset:=c) = commonHeader
c = c + 1
.Range("A1").Offset(ColumnOffset:=c) = pvtValuesToCol
'"convert" values
r = 1
trgr = 0
'loop through the collection of rows in srcWsh
Do While r < lastrow
'loop through the collection of pivoted columns in srcWsh
For c = 0 To srcWsh.Range(pivotedColumns).Columns.Count - 1
'copy original data
srcWsh.Range(unpvtFor).Offset(RowOffset:=r).Copy .Range("A2").Offset(RowOffset:=trgr)
'unpivot data - attribute
cName = srcWsh.Range(pivotedColumns).Columns(c + 1).Address
cc.Offset(RowOffset:=trgr, ColumnOffset:=0) = Trim(srcWsh.Range(cName).Rows(1))
'unpivot data - value
cc.Offset(RowOffset:=trgr, ColumnOffset:=1) = Trim(srcWsh.Range(cName).Offset(RowOffset:=r))
'increase target counter
trgr = trgr + 1
Next
'increase source counter
r = r + 1
Loop
End With
Exit_UnpivotData:
On Error Resume Next
'clean up
Set cc = Nothing
'restore previous settings
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Err_UnpivotData:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_UnpivotData
End Sub
Good luck!
Upvotes: 7
Reputation: 1645
Try this:
Sub Unpivot()
Call ReversePivotTable("Sheet1", "A", "C", "Sheet2", "Name")
End Sub
Sub ReversePivotTable(source_sheet, from_col, to_col, target_sheet, Optional type_header = "type", Optional value_header = "value")
Application.ScreenUpdating = False
LAST_ROW = Sheets(source_sheet).Cells(Rows.Count, 1).End(xlUp).Row
If LAST_ROW > 1 Then
Sheets(target_sheet).Cells.ClearContents
Else
Exit Sub
End If
pvt_type_col = Sheets(target_sheet).Range(to_col & 1).Offset(0, 1).Column 'D
pvt_value_col = Sheets(target_sheet).Range(to_col & 1).Offset(0, 2).Column 'E
'get headers
Sheets(source_sheet).Range(from_col & ":" & to_col).Copy
Sheets(target_sheet).Range("A1").PasteSpecial xlPasteValues
Sheets(target_sheet).Cells(1, pvt_type_col).Value = type_header
Sheets(target_sheet).Cells(1, pvt_value_col).Value = value_header
'tranform data
curr_row = 2
With Sheets(source_sheet)
last_col = .Cells(1, Columns.Count).End(xlToLeft).Column
For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
Set Rng = .Range(.Cells(c.Row, pvt_type_col), .Cells(c.Row, last_col))
numbers = Application.WorksheetFunction.CountIf(Rng, "<>""")
If numbers > 0 Then
Sheets(target_sheet).Range(from_col & curr_row & ":" & from_col & curr_row + numbers - 1).Value = Sheets(source_sheet).Range(from_col & c.Row & ":" & to_col & c.Row).Value
Application.CutCopyMode = False
b = curr_row
For a = pvt_type_col To last_col Step 1
If IsNumeric(.Cells(c.Row, a).Value) Then
'If .Cells(c.Row, a).Value <> "" Then
Sheets(target_sheet).Cells(b, pvt_type_col) = .Cells(1, a)
Sheets(target_sheet).Cells(b, pvt_value_col) = .Cells(c.Row, a)
b = b + 1
End If
Next a
curr_row = curr_row + numbers
If curr_row Mod 10 = 0 Then DoEvents
End If
Next c
End With
Sheets(target_sheet).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Upvotes: 0