VBA: Make simple macro run faster

Question

I need to search two tables which change daily for certain values, then highlight the corresponding cells in grey and write the thresholds in the first column of each table.

For this I am using the following approach which works as intended.
Unfortunately, the macro needs more than one minute to complete this which to me seems very long for such an action (and this macro is only part of a larger one).

Both tables are relatively small and only contain approx. 500 resp. 100 records.

Can someone tell me how I can make this run faster or write this code more efficient ?

My code:

Sub PrepareRankRecords(varMode As String)
    Call RankRecords(varMode, 10000)
    Call RankRecords(varMode, 5000)
    Call RankRecords(varMode, 2000)
    Call RankRecords(varMode, 1500)
    Call RankRecords(varMode, 1000)
    Call RankRecords(varMode, 500)
End Sub

Sub RankRecords(varMode As String, varRank As Integer)
    Dim cell As Range, varRange As Range

    If varMode = "DSP" Then
         ' table AE:AJ
        Application.StatusBar = "90 % - Ranking table AE:AJ"
        DoEvents
        Set varRange = Range("$AI$3", Cells(Rows.Count, "AI").End(xlUp)).Cells
    Else
         ' table X:AC
        Application.StatusBar = "60 % - Ranking table X:AC"
        DoEvents
        Set varRange = Range("$AB$3", Cells(Rows.Count, "AB").End(xlUp)).Cells
    End If
    With Worksheets(4)
        For Each cell In varRange
            If cell.Offset(0, -3).Value <> "" Then
                If cell.Value < varRank Then
                    cell.Offset(0, -4).Value = "< " & Format(varRank, "#,##0")
                    .Range(Cells(cell.Row, cell.Column - 4), Cells(cell.Row, cell.Column + 1)). _
Interior.Color = RGB(217, 217, 217)
                    .Range(Cells(cell.Row, cell.Column - 4), Cells(cell.Row, cell.Column + 1)). _
Font.Bold = True
                    Exit For
                End If
            Else
                Exit For
            End If
        Next
    End With
End Sub

Many thanks in advance for any help with this, Mike

Put your data to an array and do all the heavy lfting there and then write back to the spreadsheet. — SJR
– SJR, Commented May 9, 2017 at 16:48

Graham · Accepted Answer · 2017-09-21 15:44:06Z

1

Usually what I would do is the following:

Sub PrepareRankRecords(varMode As String)
    call Onstart
    Call RankRecords(varMode, 10000)
    Call RankRecords(varMode, 5000)
    'other code
    call OnEnd
End Sub

Public Sub OnEnd()

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.AskToUpdateLinks = True
    Application.DisplayAlerts = True
    Application.Calculation = xlAutomatic
    ThisWorkbook.Date1904 = False

    Application.StatusBar = False

End Sub

Public Sub OnStart()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Application.Calculation = xlAutomatic
    ThisWorkbook.Date1904 = False

    ActiveWindow.View = xlNormalView

End Sub

You may inspect the OnStart/OnEnd and remove the parts that you consider useless.

edited Sep 21, 2017 at 15:44

Graham

7,86020 gold badges67 silver badges92 bronze badges

answered May 9, 2017 at 14:47

Vityata

43.7k10 gold badges64 silver badges110 bronze badges

Sign up to request clarification or add additional context in comments.

6 Comments

keewee279 Over a year ago

Thanks, Vityata. I like this approach (some of it I already had, just not copied here). :)

keewee279 Over a year ago

I tested this and it works great (first time the calculation needs to be changed to Manual I assume. ;) ). Just one question: When I switch off the screen updating I cant show the progress on the status bar anymore, right ?

Vityata Over a year ago

@keewee279 - Manual is quite dangerous, I never use it. But it would be slightly faster.

keewee279 Over a year ago

Thanks but then you set it to Automatic both on start and on end ?

Vityata Over a year ago

@keewee279 - just to make sure... One is never 100% sure. E.g., somewhere in the middle of the code you can change it to Manual and then suffer a lot, if you do not change it back.

|

avb · Accepted Answer · 2017-05-09 14:50:30Z

0

I would replace Cells(cell.Row, cell.Column - 4) with cell(1, -3).

Also I would replace consecutive calling of RankRecords with using Select Case inside your main loop to do all things in one pass.

answered May 9, 2017 at 14:50

avb

1,8531 gold badge14 silver badges24 bronze badges

3 Comments

keewee279 Over a year ago

Thanks, avb. This is not what I need as my rows change dynamically and I need all cases, not just one of them. :)

avb Over a year ago

But, if I understand this well it would be possible not to lose anything and do it in one pass

keewee279 Over a year ago

I would be happy to but dont see a way for it and case wouldnt work here as all cases will apply all the time and I dont want to duplicate code.

Collectives™ on Stack Overflow

VBA: Make simple macro run faster

2 Answers 2

6 Comments

3 Comments

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

6 Comments

3 Comments

Related