Excel VBA, transformation of data crashes excel

[jrwrita]

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.

    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

 

[ask2tsp]

I'm terribly sorry for this very late response, it totally slipped my mind.

Can you tell me what the error is (error number, text). I will investigate what is causing it.

 

[jrwrita]

I'm terribly sorry for this very late response, it totally slipped my mind.

Can you tell me what the error is (error number, text). I will investigate what is causing it.

I get an error on line

outData = WorksheetFunction.Transpose(inData)

But it does work for the first 46 rows, which is the right amount of columns per row in my source sheet.