VBA Code crashing

KhushalJain · Apr 18th 2021

Hi Team,

I had written a VBA code, which ran when ran it step by step. But it crashes when run directly. So I broke down it into steps to check where the error is.

Pasting below the code which crashes when run directly and works fine when run step by step. Can anyone please help me what's wrong:

Note: I've already declared the variables and objects in Step1.

Code

Sub Step2()

macro_wb.Worksheets("Acc_Mt_Data").Activate
Range("B2:B" & lr).Select
Selection.NumberFormat = "d-mmm-yy"
Range("A1").Value = "ACCOUNT_NUMBER"
Range("B1").Value = "ACCOUNT_OPENING_DATE"

macro_wb.Worksheets("Dashboard_Data").Activate
Range("A1").Value = "ACCOUNT_NUMBER"
Range("B1").Value = "PHYSICAL_FILE_RECEIVING_DATE"
Range("C1").Value = "OBS NUMBER"
Range("D1").Value = "CUSTOMER NAME"
Range("E1").Value = "RIM NUMBER"


For i = 1 To db_count

    Workbooks.Open Filename:=dashboards_path(i) & dashboards(i), UpdateLinks:=False, ReadOnly:=True
'Range("").Select
    Worksheets(dashboard_sheets(i)).Activate
    ActiveSheet.AutoFilterMode = False
    Call last_row
    
    If dashboards(i) = "GENM DASHBOARD.xlsx" Then
    
        Range("1:1").Select
        Selection.AutoFilter Field:=10, Criteria1:="=OPENED" _
            , Operator:=xlAnd
        Selection.AutoFilter Field:=32, Criteria1:="<>" _
            , Operator:=xlAnd
        
        Sheets(dashboard_sheets(i)).Range("H2:H" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Activate
        Call last_row
        lr1 = lr
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 1).PasteSpecial Paste:=xlPasteValues

        Workbooks(dashboards(i)).Activate
        Call last_row

        Sheets(dashboard_sheets(i)).Range("H2:H" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 2).PasteSpecial Paste:=xlPasteValues
        
        Sheets(dashboard_sheets(i)).Range("B2:B" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 3).PasteSpecial Paste:=xlPasteValues
            
        Sheets(dashboard_sheets(i)).Range("F2:F" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 4).PasteSpecial Paste:=xlPasteValues
        
        Sheets(dashboard_sheets(i)).Range("G2:G" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 5).PasteSpecial Paste:=xlPasteValues
        
    Else
    
        Range("1:1").Select
        Selection.AutoFilter Field:=13, Criteria1:="=OPENED" _
            , Operator:=xlAnd
        Selection.AutoFilter Field:=27, Criteria1:="<>" _
            , Operator:=xlAnd
        
        Sheets(dashboard_sheets(i)).Range("I2:I" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Activate
        Call last_row
        lr1 = lr
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 1).PasteSpecial Paste:=xlPasteValues
        
        Workbooks(dashboards(i)).Activate
        Call last_row

        Sheets(dashboard_sheets(i)).Range("AA2:AA" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 2).PasteSpecial Paste:=xlPasteValues
        
        Sheets(dashboard_sheets(i)).Range("D2:D" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 3).PasteSpecial Paste:=xlPasteValues
            
        Sheets(dashboard_sheets(i)).Range("F2:F" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 4).PasteSpecial Paste:=xlPasteValues
        
        Sheets(dashboard_sheets(i)).Range("H2:H" & lr).SpecialCells(xlCellTypeVisible).Copy
        macro_wb.Worksheets("Dashboard_Data").Cells(lr1 + 1, 5).PasteSpecial Paste:=xlPasteValues

    End If
    Application.CutCopyMode = False
    Workbooks(dashboards(i)).Activate
    ActiveWorkbook.Close SaveChanges:=False
    
Next

Worksheets("Summary").Activate
Range("A1").Select

End Sub

Display More

**Carim** · Apr 18th 2021

Hello,

There are many reasons for this code not to run as smoothly as you could expect it ...

As a general rule, you should also get rid of all the instructions with Activate and with Select

How have you declared your variables ??? As Private ...??? As Public ...??

Finally, a macro is designed and belongs to a workbook ...

so, for consistency and testing purposes, attaching your file would be more helpful ....

Hope this will help

KhushalJain · Apr 18th 2021

I have declared all the variables as Public. Give me a while, I'll see if I can attach the workbook.

KhushalJain · Apr 18th 2021

But Carim , I wouldn't be able to replace the activate to select everywhere, since at times it's about activating the different excel window at different instance.

KhushalJain · Apr 18th 2021

Carim Attaching the sample workbook.Sample_Workbook.xlsm

**Carim** · Apr 19th 2021

Hello,

Thanks for your sample workbook.

As soon as I have a moment, will dive into your macros ...

**royUK** · Apr 19th 2021

Trying to understand your code is a nightmare. It's difficult to follow which sheet is being used.

You should not use error handlers until you have the code working. You are stopping any useful error messages!

I'm not sure if I have followed this correctly, but this is how to avoid selecting and activating.

It's also a good idea to add notes to the code

Code

Sub Step1()
    Dim oWb As Workbook
    OptimizedMode True
    
    macro_wb_name = ActiveWorkbook.Name
    Set macro_wb = Workbooks(macro_wb_name)
    
    Set acct_mt_sht = macro_wb.Sheets("Acc_Mt_Data")
    Set dashboard_sht = macro_wb.Sheets("Dashboard_Data")
    
    acct_mt_sht.Cells.ClearContents
    dashboard_sht.Cells.ClearContents
    macro_wb.Worksheets("Sheet1").Select
    
    'Range("F2").Select
    'Selection.End(xlDown).Select
    With macro_wb.Worksheets("Sheet1")
        lr = .Cells(.Rows.Count, 6).End(xlUp).Row
    End With
    db_count = lr - 2
    ReDim dashboards_path(db_count)
    ReDim dashboards(db_count)
    ReDim dashboard_sheets(db_count)
    For i = 1 To db_count
        dashboards_path(i) = Range("F" & 2 + i).Value
        dashboards(i) = Range("G" & 2 + i).Value
        dashboard_sheets(i) = Range("H" & 2 + i).Value
    Next
    
    acc_mt_path = Range("B4").Value
    acc_mt = Range("C4").Value
    output_path = Range("B3").Value
    current_status_path = Range("B5").Value
    current_status = Range("C5").Value
    
    Set oWb = Workbooks.Open(acc_mt_path & acc_mt)
    'Range("").Select
    sheet_count = oWb.Sheets.Count
    
    For i = 2 To sheet_count - 1
        
        With oWb.Sheets(i)
            .Rows("1048576:1048576").Cut Sheets(sheet_count).Select
            '    Call last_row
            .Rows(lr & ":" & lr).Insert Shift:=xlDown
            Rows("1:1").Insert Shift:=xlDown
            .Range("A1:F1").Copy Destination:=Sheets(i).Range("A1")
        End With
    Next
    
    Sheets(sheet_count).Rows("1:1").Insert Shift:=xlDown
    
    Sheets(1).Range("A1:H1").Copy Destination:=Sheets(i).Range("A1")
    
    Sheets.Add(Before:=Sheets(1)).Name = "Active Accounts"
    
    With ActiveSheet
        .Rows("1:1").Insert Shift:=xlDown
        Sheets(2).Range("A1:G1").Copy Destination:=.Range("A1")
        .Range("B1").Insert Shift:=xlToRight
        .Range("B1").Value = "Header 1"
    End With
    
    For j = 2 To sheet_count + 1
        With Sheets(j)
            .AutoFilterMode = False
            
            Call last_row1
            
            .Columns("B:B").Insert Shift:=xlToRight
            .Range("B1").Value = "Header 1"
            .Range("B2:B" & lr).FormulaR1C1 = "=RIGHT(RC[-1],8)"
            .Range("B2:B" & lr).Value = Range("B2:B" & lr).Value
            .Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
            
            With .Range("1:1")
                .AutoFilter Field:=1, Criteria1:="=*filter 1*" _
                , Operator:=xlAnd
                .AutoFilter Field:=5, Criteria1:="=filter 2" _
                , Operator:=xlAnd
                .AutoFilter Field:=6, Criteria1:="=filter 3" _
                , Operator:=xlAnd
                .AutoFilter Field:=7, Criteria1:= _
                "<>*filter 4*", Operator:=xlAnd, Criteria2:="<>filter 5"
            End With
            '    On Error GoTo ErrorMessage
            
            .Range("A2:G" & lr).SpecialCells(xlCellTypeVisible).Worksheets("Active Accounts").Select
            Call last_row
            Sheets(1).Cells(lr + 1, 1).PasteSpecial Paste:=xlPasteValues
            
ErrorMessage:
        
        With Worksheets("Active Accounts")
            .Columns("A:G").EntireColumn.AutoFit
            
            Call last_row
            
            .Range("B1:C" & lr).SpecialCells(xlCellTypeVisible).Copy
            macro_wb.Worksheets("Acc_Mt_Data").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            
            'ActiveWorkbook.SaveAs Filename:=output_path & acc_mt
            ActiveWorkbook.Close SaveChanges:=False
            
        End With
End Sub

Display More

**Carim** · Apr 19th 2021

Unfortunately, it is not an issue of a quick fix ...

All your instructions do require to be re-written ... which will take a while ...

Will try to redesign your " Step 2 " macro ...

**Carim** · Apr 19th 2021

Seems to me you are constantly trying to determine the last row ...

Code

lr = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row

and regarding the handling of all your headers ...

Code

With Sheet2
    .Range("B2:B" & .Cells(Rows.Count, "B").End(xlUp).Row).NumberFormat = "d-mmm-yy"
    .Range("A1").Value = "Header 1"
    .Range("B1").Value = "Header 2"
End With

With Sheet3
    .Range("A1").Value = "Header 1"
    .Range("B1").Value = "Header 2"
    .Range("C1").Value = "Header 3"
    .Range("D1").Value = "Header 4"
    .Range("E1").Value = "Header 5"
End With

Display More

Hope this will help

**Carim** · Apr 19th 2021

Among the headaches you are creating yourself ...

In order to get a simple count, you are using

Code

macro_wb.Worksheets("Sheet1").Select
Range("F2").Select
Selection.End(xlDown).Select
lr = ActiveCell.Row
db_count = lr - 2

which can be achieved with a one-line instruction

Code

db_count = Sheet1.Cells(Rows.Count, "F").End(xlUp).Row - 2

Would encourage you to completely re-visit your entire code ...

Hope this will help

**Carim** · Apr 23rd 2021

Have you managed to solve your problem ...?

Should the thread be marked as resolved ...?

VBA Code crashing

Participate now!

Share

Tags