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 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(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 | +---------+------------------+-----------------+-----------+--------------+ 2 Answers
Answers 1
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
Variantdata type is assigned by default.(...)
Variables of type
Variantrequire more memory resources than most other variables(...)
If a module includes the
Option Explicitstatement, 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.xlsm - 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 '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 Exit Sub Err_UnpivotData: MsgBox Err.Description, vbExclamation, Err.Number Resume Exit_UnpivotData End Sub Good luck!
Answers 2
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 
0 comments:
Post a Comment