excelguy
excelguy

Reputation: 1624

Excel VBA, transforming Data leads to crashing of excel

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

Answers (2)

Maciej Los
Maciej Los

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

Pawel Czyz
Pawel Czyz

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

Related Questions