ritu pallavi
ritu pallavi

Reputation: 11

Excel Workbook with VBA macro taking a long time to open

I have written a macro to automate my daily task of filtering a value and then copy in a different sheet. My Macro is done but when I try to open the excel file it takes longer time to open.

Private Sub CommandButton1_Click()

    Dim autofiltrng As Range
    Dim total_data As Range
    Dim specific_column As Range

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With

    On Error Resume Next

    Sheets("MasterRolePLMap").ShowAllData

    On Error GoTo 0
    'Filter the data as per CompetencyView

    Sheets("MasterRolePLMap").Range("A1").AutoFilter field:=1, Criteria1:=Sheets("CompetencyView").Range("C5").Value

    With Sheets("MasterRolePLMap").AutoFilter.Range
        On Error Resume Next

        'Focus only on visible cells

        Set autofiltrng = .Offset(1, 0).Resize(.Rows.Count - 1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With

    If autofiltrng Is Nothing Then
        MsgBox "No Data to Copy"

    Else
        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("D:D").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 2).Select
        Sheets("CompetencyView").Paste

        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("F:F").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 3).Select
        Sheets("CompetencyView").Paste

        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("E:E").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 4).Select
        Sheets("CompetencyView").Paste

        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("G:G").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 5).Select
        Sheets("CompetencyView").Paste

        Sheets("MasterRolePLMap").Activate

        Sheets("MasterRolePLMap").Range("C:C").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("CompetencyView").Activate
        Sheets("CompetencyView").Cells(14, 6).Select
        Sheets("CompetencyView").Paste
    End If

    Sheets("CompetencyView").Activate
    Set total_data = Sheets("CompetencyView").Range("B15:F1048576")
    Set specific_column = Sheets("CompetencyView").Range("E15:E1048576")
    total_data.Sort key1:=specific_column, order1:=xlAscending

    If IsEmpty(Range("B15").Value) = True Then
        With Range(Range("B14"), Range("B14").End(xlToRight)).Borders
            .LineStyle = xlcontinous
            .Weight = xlThin
        End With
    Else
        With Range(Range("B14"), Range("B14").End(xlToRight).End(xlDown)).Borders
            .LineStyle = xlcontinous
            .Weight = xlThin
        End With
    End If

    With Application
        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

End Sub

Upvotes: 1

Views: 2243

Answers (1)

HonnSolo
HonnSolo

Reputation: 165

Set total_data = Sheets("CompetencyView").Range("B15:F1048576")
Set specific_column = Sheets("CompetencyView").Range("E15:E1048576")

I think these lines might be the issue. I think it is what is generating too many rows. Try specifying the range:

i = Sheets("CompetencyView").Cells(rows.count,6).End(xlUp).row
Set total_data = Sheets("CompetencyView").Range(Cells(15,2),Cells(i,6))
i = Sheets("CompetencyView").Cells(rows.count,5).End(xlUp).row
Set specific_column = Sheets("CompetencyView").Range(Cells(15,5),Cells(i,5))

Let me know if that helped.

Upvotes: 2

Related Questions