Speeding up macro code

[peacenik]

Can anyone give me some hints to improve the speed of this code?

Sub buildbusinesswriterstats()
Dim businesswriters(999, 2)
    Dim Counted As Boolean
Application.ScreenUpdating = False
    Sheets("Data").Activate
    For Each cell In Range("E2:E999")
        Counted = False
        For i = 0 To Counter
            If cell.Value = businesswriters(i, 0) Then
                businesswriters(i, 1) = cell.Offset(0, -4).Value
                businesswriters(i, 2) = businesswriters(i, 2) + 1
                Counted = True
                Exit For
            End If
        Next
        If Counted = False Then
            businesswriters(Counter, 0) = cell.Value
            businesswriters(Counter, 1) = cell.Offset(0, -4).Value
            businesswriters(Counter, 2) = businesswriters(Counter, 2) + 1
            Counter = Counter + 1
        End If
Sheets("Business Writers").Activate
        Range("A1").Activate
        Cells.ClearContents
        Range("A1").Value = "Business Writer"
        Range("B1").Value = "Last Lodged"
        Range("C1").Value = "No. Lodged"
        Range("D1").Value = "State"
        Range("E1").Value = "Branch"
        Range("A1:E1").Font.Bold = True
        Range("A2").Activate
        For MyRow = 0 To Counter
            For MyColumn = 0 To 2
                ActiveCell.Offset(MyRow, MyColumn).Value = businesswriters(MyRow, MyColumn)
            Next
            ActiveCell.Offset(MyRow, 3).Formula = "=VLOOKUP(A" & MyRow + 2 & ",'Business Writer List'!A:D,3,FALSE)"
            ActiveCell.Offset(MyRow, 4).Formula = "=VLOOKUP(A" & MyRow + 2 & ",'Business Writer List'!A:D,4,FALSE)"
        Next
    Next
    Application.ScreenUpdating = True
End Sub

[Richie(UK)]

Hi p,

OK, a few suggestions:

1. In addition to switching off Screenupdating, consider setting Calculation to manual at the start of your routine and then resetting it to its original state at the end.

2. Explicity declare all of your variables.

3. It is rarely necessary to either Select or Activate objects in order to work with them - all this does is make your code slower. Set object variables and use these instead.

4. Where you make repeated reference to the same object consider using a With ... End With construct.

HTH

[Bob Phillips]

Can anyone give me some hints to improve the speed of this code?

Generally it doesn't look to bad, few unnnecessary selections etc.

Two thoughts spring out.

First, the work on the "Business Writers" sheet doesn't seem to need to be done for every loop of range E2:E999, it is the same stuff evry time, and turn calculation off.

Option Explicit

Sub buildbusinesswriterstats()
Dim businesswriters(999, 2)
    Dim Counted As Boolean
Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
Sheets("Data").Activate
    For Each cell In Range("E2:E999")
        Counted = False
        For i = 0 To Counter
            If cell.Value = businesswriters(i, 0) Then
                businesswriters(i, 1) = cell.Offset(0, -4).Value
                businesswriters(i, 2) = businesswriters(i, 2) + 1
                Counted = True
                Exit For
            End If
        Next
        If Counted = False Then
            businesswriters(Counter, 0) = cell.Value
            businesswriters(Counter, 1) = cell.Offset(0, -4).Value
            businesswriters(Counter, 2) = businesswriters(Counter, 2) + 1
            Counter = Counter + 1
        End If
    Next
Sheets("Business Writers").Activate
    Cells.ClearContents
    Range("A1").Value = "Business Writer"
    Range("B1").Value = "Last Lodged"
    Range("C1").Value = "No. Lodged"
    Range("D1").Value = "State"
    Range("E1").Value = "Branch"
    Range("A1:E1").Font.Bold = True
    With Range("A2")
        For MyRow = 0 To Counter
            For MyColumn = 0 To 2
                .Offset(MyRow, MyColumn).Value = businesswriters(MyRow, MyColumn)
            Next
            ActiveCell.Offset(MyRow, 3).Formula = "=VLOOKUP(A" & MyRow + 2 & ",'Business Writer List'!A:D,3,FALSE)"
            ActiveCell.Offset(MyRow, 4).Formula = "=VLOOKUP(A" & MyRow + 2 & ",'Business Writer List'!A:D,4,FALSE)"
        Next
    End With
Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

[doctordoggie]

Without actually running this, it looks like this could in theory process cells which don't contain any data (that would make it process 999 cells even if only the first cell contains something.

If you include just after the line For Each cell In Range("E2:E999") a quick validation check to see if anything is there, you could make the rest of the code in the loop conditional. That would speed things up.

Something like:

For Each cell In Range("E2:E999") 
        Counted = False 
        If cell.Value <> "" then  '<---This can be any kind of validation you need
             For i = 0 To Counter 
.
.
.
.

Don't forget to put your End If in there!

I hope this gives you an idea.

Note: you can also use Exit For to come out of a for... next loop when you know you've reached the end of your data. I do that all the time when processing lists.

[Bob Phillips]

4. Where you make repeated reference to the same object consider using a With ... End With construct.

Try timing this, you might be surprised.

[peacenik]

Generally it doesn't look to bad, few unnnecessary selections etc.

Two thoughts spring out.

First, the work on the "Business Writers" sheet doesn't seem to need to be done for every loo[ of range E2:E999, it is the sma estuff evry time, and turn calculation off.

Thanks. That was exactly the problem. Silly me.

[Richie(UK)]

Try timing this, you might be surprised.

I tried ... I wasn't surprised.

I used an API timer (courtesy of Mssrs Bullen, Green, Bovey, and Rosenberg) in a Class Module called "CHighResTimer". Like this :

'How many times per second is the counter updated?
Private Declare Function QueryFrequency Lib "kernel32" _
        Alias "QueryPerformanceFrequency" ( _
        lpFrequency As Currency) As Long
'What is the counter's value
Private Declare Function QueryCounter Lib "kernel32" _
        Alias "QueryPerformanceCounter" ( _
        lpPerformanceCount As Currency) As Long
'Variables to store the counter information
Dim mcyFrequency As Currency
Dim mcyOverhead As Currency
Dim mcyStarted As Currency
Dim mcyStopped As Currency


Private Sub Class_Initialize()
   Dim cyCount1 As Currency, cyCount2 As Currency
'Get the counter frequency
   QueryFrequency mcyFrequency
'Call the hi-res counter twice, to check how long it takes
   QueryCounter cyCount1
   QueryCounter cyCount2
'Store the call overhead
   mcyOverhead = cyCount2 - cyCount1
End Sub

Public Sub StartTimer()
   'Get the time that you started
   QueryCounter mcyStarted
End Sub

Public Sub StopTimer()
   'Get the time that you stopped
   QueryCounter mcyStopped
End Sub

Public Property Get Elapsed() As Double
   Dim cyTimer As Currency
'Have you stopped or not?
   If mcyStopped = 0 Then
      QueryCounter cyTimer
   Else
      cyTimer = mcyStopped
   End If
'If you have a frequency, return the duration, in seconds
   If mcyFrequency > 0 Then
      Elapsed = (cyTimer - mcyStarted - mcyOverhead) / mcyFrequency
   End If
End Property[/vba]And then did a couple of fairly simple tests:
[vba]Sub Test1()
    Dim lLoop As Long
    Dim obTimer As New CHighResTimer
obTimer.StartTimer
    'start the timer
For lLoop = 1 To 50000
        ThisWorkbook.Worksheets("Sheet1").Range("A" & lLoop).Value = "Testing, testing ..."
        ThisWorkbook.Worksheets("Sheet1").Range("A" & lLoop).Font.Bold = True
        ThisWorkbook.Worksheets("Sheet1").Range("A" & lLoop).Interior.ColorIndex = 4
        ThisWorkbook.Worksheets("Sheet1").Range("A" & lLoop).Offset(0, 1).Value = 123456
    Next lLoop
obTimer.StopTimer
    'stop the timer
MsgBox "Code execution took " & obTimer.Elapsed & " seconds"
    'display the time taken
End Sub

Sub Test2()
    Dim lLoop As Long, ws As Worksheet
    Dim obTimer As New CHighResTimer
obTimer.StartTimer
    'start the timer
Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ws
        For lLoop = 1 To 50000
            .Range("A" & lLoop).Value = "Testing, testing ..."
            .Range("A" & lLoop).Font.Bold = True
            .Range("A" & lLoop).Interior.ColorIndex = 4
            .Range("A" & lLoop).Offset(0, 1).Value = 123456
        Next lLoop
    End With
obTimer.StopTimer
    'stop the timer
MsgBox "Code execution took " & obTimer.Elapsed & " seconds"
    'display the time taken
End Sub

The first came in at 39.72 seconds and the second at 32.94 seconds.

I thought the use of With statements was fairly widely regarded as being more efficient. For example, Chip Pearson includes it here. Does your experience suggest that this might not be the case? I'm always willing to learn 'new tricks'.

[Bob Phillips]

I thought the use of With statements was fairly widely regarded as being more efficient. For example, Chip Pearson includes it here. Does your experience suggest that this might not be the case? I'm always willing to learn 'new tricks'.

With statements should be more efficient as the object is reserved in memory, and so any subsequent reference to that object, via a .property or .method, would go to memory, not having to go its tyhpe library to get info on the object. But ... many times I have timed the code and regularly I have found it not to be efficient. Not what I expected, but I have had it.

BTW, I am not advocating not doing it. I would use With ... End With every time for maintainability and readability even when slower (I have never found it hugely slower), just that I am personally cautious about saying it is quicker. Screenupdating, calculation mode, selecting, they are undisputed, but some things are more marginal.