0
\$\begingroup\$

I have the following code that works correctly on small data-sets, but times out and crashes on large data sets. The goal of this code is to take a tabular view of data on one sheet and transform it to a vertical view. Excel crashes due to the performance issues when scaling this to 45k+ rows. The code is functional; it just performs very poorly on large inputs.

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 |
+---------+------------------+-----------------+-----------+--------------+
\$\endgroup\$
  • \$\begingroup\$ Is it slow and makes Excel "not responding", or does it crash Excel? There's a major difference between the two wordings; slow code can be optimized, but crashing code has bugs and isn't ready for a peer review. Please see the help center and edit your post accordingly. \$\endgroup\$ – Mathieu Guindon May 31 '18 at 2:17
  • \$\begingroup\$ It works correctly, ie if I run step through the code the results show, but it seems like a performance issue when I run it all at once. Not sure what else is needed to edit this question. \$\endgroup\$ – excelguy May 31 '18 at 13:32
  • \$\begingroup\$ It doesn't crash then. You need to reword the post so that it doesn't imply that your code blows up. Then it can be reopened. Cheers! \$\endgroup\$ – Mathieu Guindon May 31 '18 at 13:37
  • 1
    \$\begingroup\$ Disabling screen-updating isn't enough. Usually you also have to disable automatic-updating that are triggered when you are writing to the sheet. Just try to follow this recommendations: Excel VBA Speed and Efficiency \$\endgroup\$ – t3chb0t May 31 '18 at 14:10
  • \$\begingroup\$ Adding data and result screenshots would make it easier what you are trying to accomplish. \$\endgroup\$ – TinMan Jun 21 '18 at 1:17
2
\$\begingroup\$

I very much would like to review this code, but I can't for the life of me understand it. Let's check some variables. I see a, b, c, to_col, from_col, curr_row, pvt_type_col, pvt_value_col, numbers.

I'll give you credit for from_col, to_col and curr_row despite the awful naming. But WHAT IS b? It iterates, but I have no idea why it iterates. I can usually remember c is a cell, but what would a be?

Not to mention, not one variable is declared so I couldn't even think about knowing what type of data it might be, which might lead me to thinking of something it could be.

Give You Variables Meaningful Names

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

When you don't define your variable, VBA will declare it as a Variant type that can hold any type of data. While this may be more flexible, it adds processing time to your macro as VBA decides or tests for the type. Additionally, since a Variant can be any type of data, you may miss out on valuable troubleshooting information on Type Mismatch

Pay attention to Standard VBA naming conventions.

And of course give your variables meaningful names. If a is pivot table columns, then at least just use pivotTableColumn instead.

And numbers - I can't even.


All right, that sounded sort of mean. Please don't take it that way, but I'm frustrated that I can't help you. There are some basics to take away as well -

  • You know copy and paste are slow. There's never any reason to use them when you can do the work in a variable instead. There's a good question on StackOverflow addressing this.
  • Why are you using countif - a worksheet function? And then you follow that with an if. Just simply something like for each cell in range if not cell = """ then go ahead
  • This type of thing Sheets(source_sheet).Range(from_col & c.Row & ":" & to_col & c.Row).Copy isn't very legible.
  • You probably have some comments to remind yourself, but Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.
  • You don't need to Call subs, it's obsolete. Instead just use Sub argument, argument
  • Your arguments in your routine are all passed ByRef implicitly. If possible, you should pass argument ByVal rather than ByRef.

Good job trying to write some VBA to do what you need - really we all start somewhere. I'm not trying to make you feel bad about your code - you shouldn't, but sometimes getting the basics down can solve problems and if not, then at least it can be understood properly.

I mean you're here at code review, so you've already put in more effort than a lot of people and you want to learn how to be better. Those are great things!

\$\endgroup\$
2
\$\begingroup\$

A few notes:

  • Declare your variables. Be explicit about types. If there's a reason you need to use a Variant, great! If not, use a type with better performance (Long for loop iterators, String for column names, etc.).

  • If you're going to use one-letter names for iterators, the best practice is to use i, j, and k instead of a, b, and c. Not a huge deal, but it helps with readability.

  • It's generally a better idea to pass a worksheet reference to a function instead of passing the name of the sheet. That way, if you accidentally mistype the name of a sheet, the error will occur at the place you made the mistake (the function call) instead of within the called function itself.

  • Since you're working with tabular data, consider using Tables, or ListObjects as they're known in VBA. They tend to make code substantially more readable because a) they allow you to refer to columns by name, and b) they auto-resize as new data is added.

  • While it is often a good idea to disable ScreenUpdating, it's not a great idea to do it within helper/utility functions like this; instead, do it at the beginning/end of your main procedure. In this particular case, it's okay, because you're only calling one function. But if you were unpivoting data as a part of a series of functions (one to unpivot, one to format, one to create a chart, etc.), you wouldn't want to disable/re-enable ScreenUpdating every time you entered a procedure:

    Sub mainSubBad()
    'Disabling screen updating within the "helper" procedures. Don't do this.
        Call firstSubBad
        Call secondSubBad
        Call thirdSubBad
    End Sub
    Sub firstSubBad()
        Application.ScreenUpdating = False
        '...do stuff
        Application.ScreenUpdating = True
    End Sub
    Sub secondSubBad()
        Application.ScreenUpdating = False
        '...do stuff
        Application.ScreenUpdating = True
    End Sub
    Sub thirdSubBad()
        Application.ScreenUpdating = False
        '...do stuff
        Application.ScreenUpdating = True
    End Sub
    
    Sub mainSubGood()
    'Disabling screen updating within the main procedure. Do this instead.
        Application.ScreenUpdating = False
        Call firstSubGood
        Call secondSubGood
        Call thirdSubGood
        Application.ScreenUpdating = True
    End Sub
    Sub firstSubGood()
        '...do stuff
    End Sub
    Sub secondSubGood()
        '...do stuff
    End Sub
    Sub thirdSubGood()
        '...do stuff
    End Sub
    
  • Finally, every interaction with the worksheet (reading a value from a cell, setting the value of a cell, etc.) is costly in VBA. Copy/Paste operations are also costly. That's the biggest reason you're getting such poor performance with large datasets. As a general rule, you should never loop through cells individually in VBA. Instead, read the cell values into an array and loop through that:

    Function countCatsBad(rng As Range) As Long
    
        Dim cell As Range
        Dim catCount As Long
        For Each cell In rng
            If cell.Value = "Cat" Then
                catCount = catCount + 1
            End If
        Next
    
        countCatsBad = catCount
    
    End Function
    
    Function countCatsGood(rng As Range) As Long
    
        Dim vals As Variant
        vals = rng.Value
    
        'If only one cell in range, check value and exit
        If rng.Count = 1 Then
            countCats = IIf(vals = "Cat", 1, 0)
            Exit Function
        End If
    
        'If more than one cell in range, loop through values
        Dim catCount As Long
        Dim i As Long
        Dim j As Long
        For i = LBound(vals, 1) To UBound(vals, 1)
            For j = LBound(vals, 2) To UBound(vals, 2)
                If vals(i, j) = "Cat" then
                    catCount = catCount + 1
                End If
            Next
        Next
    
        countCatsGood = catCount
    
    End Function
    

Here's a version of the unpivot function I use in my code (along with some helper functions). It can convert a table with 10K rows + 12 pivoted columns to an unpivoted table with 120K rows in about a second.

Function unPivot(srcTbl As ListObject, ByVal toUnpivot As Variant, ByVal toRepeat As Variant, colsLabel As String, _
                 valsLabel As String, destWS As Worksheet, destTblName As String) As ListObject


    'Change arrays/strings of columns to repeat/unpivot to arrays of base 1
    toUnpivot = changeArrayBase(toUnpivot)
    toRepeat = changeArrayBase(toRepeat)

    'Set up array that will contain table data from both lists of columns
    ReDim tblData(1 To srcTbl.ListRows.Count, 1 To UBound(toUnpivot) + UBound(toRepeat)) As Variant

    'Add data from columns that will be repeated in each row of the unpivoted data
    Dim i As Long
    Dim j As Long
    Dim tempArr As Variant
    For j = 1 To UBound(toRepeat)
        tempArr = srcTbl.ListColumns(toRepeat(j)).DataBodyRange.Value2
        For i = 1 To UBound(tempArr, 1)
            tblData(i, j) = tempArr(i, 1)
        Next
    Next

    'Add data from columns that are being unpivoted
    Dim repeatCount As Long
    repeatCount = UBound(toRepeat)
    For j = 1 To UBound(toUnpivot)
        tempArr = srcTbl.ListColumns(toUnpivot(j)).DataBodyRange.Value2
        For i = 1 To UBound(tempArr, 1)
            tblData(i, j + repeatCount) = tempArr(i, 1)
        Next
    Next

    'Set up results array
    'Number of rows = number of rows in original table * number of columns being unpivoted
    'Number of columns = number of repeated columns + 2 (one column for label, one column for unpivoted values)
    ReDim newArr(1 To UBound(tblData, 1) * UBound(toUnpivot), 1 To repeatCount + 2) As Variant

    'Loop through table data and fill results array
    Dim oldRow As Long
    Dim unpivotCol As Long
    Dim repeatCol As Long
    Dim newRow As Long
    newRow = 1
    'Loop through each row in source data
    For oldRow = 1 To UBound(tblData, 1)
        'Loop through each column to be unpivoted
        For unpivotCol = 1 To UBound(toUnpivot)
            'Repeat values from repeated columns
            For repeatCol = 1 To repeatCount
                newArr(newRow, repeatCol) = tblData(oldRow, repeatCol)
            Next

            'Add name of unpivoted column to 'label' column
            newArr(newRow, repeatCount + 1) = toUnpivot(unpivotCol)

            'Add value from unpivoted column to 'value' column
            newArr(newRow, repeatCount + 2) = tblData(oldRow, unpivotCol + repeatCount)

            'Move to next row of results array
            newRow = newRow + 1
        Next
    Next

    'Loop through table data and fill results array
    Dim newRow As Long
    newRow = 1
    'Loop through each row in source data
    For i = 1 To UBound(tblData, 1)
        'Loop through each column to be unpivoted
        For j = 1 To UBound(toUnpivot)
            'Add values from repeated columns
            Dim k As Long
            For k = 1 To repeatCount
                newArr(newRow, k) = tblData(i, k)
            Next

            'Add name of unpivoted column to 'label' column
            newArr(newRow, repeatCount + 1) = toUnpivot(j)

            'Add value from unpivoted column to 'value' column
            newArr(newRow, repeatCount + 2) = tblData(i, j + repeatCount)

            'Move to next row of results array
            newRow = newRow + 1
        Next
    Next

    'Write unpivoted data to sheet and create table
    With destWS
        'Add headers
        .Cells.Clear
        .Range(.Cells(1, 1), .Cells(1, repeatCount)).Value = widen1dArray(toRepeat, 2)
        .Cells(1, repeatCount + 1).Value = colsLabel
        .Cells(1, repeatCount + 2).Value = valsLabel

        'Add data
        .Range(.Cells(2, 1), .Cells(UBound(newArr, 1) + 1, UBound(newArr, 2))).Value = newArr

        'Create table
        Dim tblRange As Range
        Set tblRange = .Range(.Cells(1, 1), .Cells(UBound(newArr, 1) + 1, UBound(newArr, 2)))
        .ListObjects.Add(xlSrcRange, tblRange, , xlYes).Name = tblName                                
    End With

    Set unPivot = destWS.ListObjects(tblName)

End Function
Function changeArrayBase(ByVal arr As Variant, Optional ByVal newBase As Long = 1) As Variant
'Changes base of 1D or 2D array (arr) to specified value (newBase)
'If arr is not an array, it is turned into a 1-element array containing the original value

    Dim tempArr As Variant
    Dim i As Long
    Dim j As Long
    Dim numDims As Long
    numDims = getDims(arr)

    If numDims = 0 Then
        ReDim tempArr(newBase To newBase) As Variant
        If IsObject(arr) Then
            Set tempArr(newBase) = arr
        Else
            tempArr(newBase) = arr
        End If
    ElseIf numDims = 1 Then
        ReDim tempArr(newBase To UBound(arr) - LBound(arr) + newBase) As Variant
        j = newBase
        For i = LBound(arr) To UBound(arr)
            If IsObject(arr(i)) Then
                Set tempArr(j) = arr(i)
            Else
                tempArr(j) = arr(i)
            End If
            j = j + 1
        Next
    ElseIf numDims > 2 Then
        MsgBox "Error: Cannot change base of arrays with >2 dimensions"
        Stop
        Exit Function
    Else
        Dim x As Long
        Dim y As Long
        x = UBound(arr, 1) - LBound(arr, 1) + newBase
        y = UBound(arr, 2) - LBound(arr, 2) + newBase
        ReDim tempArr(newBase To x, newBase To y) As Variant
        x = newBase
        For i = LBound(arr, 1) To UBound(arr, 1)
            y = newBase
            For j = LBound(arr, 2) To UBound(arr, 2)
                If IsObject(arr(i, j)) Then
                    Set tempArr(x, y) = arr(i, j)
                Else
                    tempArr(x, y) = arr(i, j)
                End If
                y = y + 1
            Next
            x = x + 1
        Next
    End If

    changeArrayBase = tempArr

End Function
Function widen1dArray(ByRef arr As Variant, Optional ByVal bigDim As Long = 1, Optional ByVal newBase As Long = 1) As Variant
'Takes a 1d array and turns it into a 2d array in which one dimension has size 1
'IE it takes an array with these dimensions:
    'Dim arr(1 To 10)
'And turns it into an array with either of these dimensions:
    'Dim arr(1 To 10, 1 To 1) [bigDim = 1]
    'Dim arr(1 To 1, 1 To 10) [bigDim = 2]

    Dim numDims As Long
    numDims = getDims(arr)

    If numDims = 0 Then
        ReDim bigArr(newBase To newBase, newBase To newBase) As Variant
        bigArr(newBase, newBase) = arr
        widen1dArray = bigArr
        Exit Function
    ElseIf numDims > 1 Then
        MsgBox "Error: Array already has more than 1 dimension"
        Stop
        Exit Function
    ElseIf bigDim = 2 Then
        ReDim tempArr(newBase To newBase, newBase To UBound(arr) - LBound(arr) + newBase) As Variant
    Else
        ReDim tempArr(newBase To UBound(arr) - LBound(arr) + newBase, newBase To newBase) As Variant
    End If

    Dim i As Long
    Dim j As Long
    j = newBase
    If bigDim = 2 Then
        For i = LBound(arr) To UBound(arr)
            If IsObject(arr(i)) Then
                Set tempArr(newBase, j) = arr(i)
            Else
                tempArr(newBase, j) = arr(i)
            End If
            j = j + 1
        Next
    Else
        For i = LBound(arr) To UBound(arr)
            If IsObject(arr(i)) Then
                Set tempArr(j, newBase) = arr(i)
            Else
                tempArr(j, newBase) = arr(i)
            End If
            j = j + 1
        Next
    End If

    widen1dArray = tempArr

End Function
Function getDims(x As Variant) As Long
'Gets dimensions of an array; returns 0 for non-arrays

    On Error GoTo Err

    Dim i As Long
    Dim tempVal As Long
    i = 0
    Do While True
        i = i + 1
        tempVal = UBound(x, i)
    Loop

Err:
    On Error GoTo 0
    getDims = i - 1
End Function

EDIT: The OP requested an example of how you'd use the "unPivot" function. The basic setup is similar to the OP in that there's a main sub + helper functions. The main sub would look something like this, assuming your source data is already in a table:

Dim sourceTable As ListObject
Dim newTable As ListObject
Set sourceTable = ThisWorkbook.Sheets("Example").ListObjects("ExampleTable")
Set newTable = unPivot(sourceTable, Array("Person 1", "Person 2", "Person 3"), "Household", _
                       "Person", "Name", ThisWorkbook.Sheets("Results"), "ResultsTable")
'Then do whatever you want with the results, like deleting blank rows, formatting, etc.
\$\endgroup\$
  • \$\begingroup\$ I have some questions about your code, could you start a chat with me? Where do I input my sheet names? \$\endgroup\$ – excelguy Jul 3 '18 at 19:46
  • \$\begingroup\$ I'll add a note to my answer. \$\endgroup\$ – Daniel McCracken Jul 6 '18 at 14:18
  • \$\begingroup\$ Im still having some trouble implementing my sheets, could you help? \$\endgroup\$ – excelguy Jul 9 '18 at 16:03
0
\$\begingroup\$

Try adding application.calculation=xlmanual at the top and remove the doevents. At the bottom add application.calculation=xlautomatic and then add do events.

I think you’re recalculating too much for the data you’re working with

\$\endgroup\$
  • \$\begingroup\$ would you be able to show me where the do events would be? \$\endgroup\$ – excelguy Jun 15 '18 at 15:23
  • \$\begingroup\$ The correct syntax isApplication.Calculation = xlCalculationManual and Application.Calculation = xlCalculationAutomatic \$\endgroup\$ – TinMan Jun 21 '18 at 1:15

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.