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? I need to avoid writing cell by cell and copy and pasting. Crashes my excel.
does anyone have any tips for optimizing this code? I need to avoid writing cell by cell and copy and pasting. Crashes my excel.
Code:
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