Excel VBA: Long Execution Time

Question

I've created a VBA code to delete extra rows and columns that were needed for initial calculations but are required to be removed before converting/importing a csv into a database. The code loops through 21 sheets and runs for about 4 minutes. Is this a decent run time or can it be shortened? ~Thanks

Public Sub Test()

Dim xWs As Worksheet
Set xWs = ActiveSheet
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

'SETTING DEPENDENT VALUES TO ABSOLUTE VALUES============================='

For Each xWs In Application.ActiveWorkbook.Worksheets
    xWs.Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    xWs.DisplayPageBreaks = False
    xWs.UsedRange.Value = xWs.UsedRange.Value
Next

'DELETING ROWS BASED ON COLUMN B VALUES=================================='

For Each xWs In Application.ActiveWorkbook.Worksheets
    xWs.Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    xWs.DisplayPageBreaks = False
    Firstrow = xWs.UsedRange.Cells(1).Row
    Lastrow = xWs.UsedRange.Rows(xWs.UsedRange.Rows.count).Row
    For Lrow = Lastrow To Firstrow Step -1
        With xWs.Cells(Lrow, "B")
            If Not IsError(.Value) Then
                If .Value = "0" Then .EntireRow.Delete
            End If
        End With
    Next Lrow
Next

'DELETING DUPLICATE IP ADDRESSES=========================================='

With Sheets("IP-Unassigned")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Firstrow = .UsedRange.Cells(1).Row
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.count).Row
    For Lrow = Lastrow To Firstrow Step -1
        With .Cells(Lrow, "H")
            If Not IsError(.Value) Then
                If .Value = "1" Then .EntireRow.Delete
            End If
        End With
    Next Lrow
End With

'DELETING EXTRA COLUMNS========================================================'

With Sheets("IP-FSW")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-2070")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-MNTR")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-BBS")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-DET")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-TTR")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-CCTV")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(8).EntireColumn.Delete
    Columns(7).EntireColumn.Delete
End With

With Sheets("IP-Unassigned")
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False
    Columns(16).EntireColumn.Delete
    Columns(15).EntireColumn.Delete
    Columns(14).EntireColumn.Delete
    Columns(13).EntireColumn.Delete
    Columns(12).EntireColumn.Delete
    Columns(11).EntireColumn.Delete
    Columns(10).EntireColumn.Delete
    Columns(9).EntireColumn.Delete
    Columns(8).EntireColumn.Delete
End With

'=========================================================================='

End Sub

Just a thought (and it might be way off base). Is it any faster if you disable automatic calculations first....? Or if you use something like "Sheets("MyWorksheet").UsedRange.ClearContents" ...? — Mike Gledhill
– Mike Gledhill, Commented Apr 6, 2018 at 18:16
I'm voting to close this question as off-topic because it should be considered for code review site as it code optimization. — QHarr
– QHarr, Commented Apr 7, 2018 at 8:49

paul bica · Accepted Answer · 2018-04-07 08:46:45Z

In the code bellow

Condensed the OP code
Stopped ScreenUpdating and Events
Replaced row-by-row deletion in loops with bulk-deletion in AutoFilters

Option Explicit

Public Sub RemoveTmpData()
    Const WS_2COLS = "|IP-FSW|IP-2070|IP-MNTR|IP-BBS|IP-DET|IP-TTR|IP-CCTV|"
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Application.EnableEvents = False
        For Each ws In ThisWorkbook.Worksheets
            ws.DisplayPageBreaks = False
            ws.UsedRange.Value2 = ws.UsedRange.Value2   'convert formulas to values
            If InStr(WS_2COLS, "|" & ws.Name & "|") > 0 Then ws.Columns("G:H").Delete
            RemoveTmpRows ws.UsedRange, 2, 0            'remove rows with val 0, in col B
        Next

        With ThisWorkbook.Worksheets("IP-Unassigned")
            RemoveTmpRows .UsedRange, 8, 1              'remove rows with val 1, in col H
            .UsedRange.Columns("H:P").Delete
        End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Private Sub RemoveTmpRows(ByRef rng As Range, ByVal colId As Long, ByVal crit As String)
    With rng
        .AutoFilter Field:=colId, Criteria1:=crit
        If .Columns(colId).SpecialCells(xlCellTypeVisible).CountLarge > 1 Then
            .Rows(1).Hidden = True
            .SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .Rows(1).Hidden = False
        End If
        .AutoFilter
    End With
End Sub

C. van Dorsten · Accepted Answer · 2018-04-06 20:38:30Z

Public Sub Test()

  Dim xWs As Worksheet
  Set xWs = ActiveSheet
  Dim Firstrow As Long
  Dim Lastrow As Long
  Dim Lrow As Long
  Dim CalcMode As Long
  Dim ViewMode As Long

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  '... Your stuff

  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Might speed up a lot. This prevents screen updates, automatic calculation and events from firing while processing. These three are known to slow down performance. If this doesn't speed up performance conciderably, you should post a xml with the macro and test data, so we can have a close look.

Collectives™ on Stack Overflow

Excel VBA: Long Execution Time

2 Answers 2

1 Comment

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related