Can this code run faster?

[BigShango]

I have just replaced a speadsheet full of countif formulas with VBA code. I assumed this would make the sheet work faster. It does work faster when using it, as it no-longer recalculates constantly, but the initial calculation takes around 5 minutes, when it used to take 30-40 seconds.

Here is my code

Sub Count()
    Dim Staff, ReviewsOut, PDPsOut, ReportRow, DataRow, LastRow, LastRow2 As Integer
    Dim Manager As String
    Dim ReviewDate As Date
  
        Application.ScreenUpdating = False
        Application.Cursor = xlWait
        Application.DisplayStatusBar = True
        Application.StatusBar = "Calculating..."
    
    
    Sheets("Report").Select
    ReviewDate = Range("B1").Value              ' review date stored
        
    Range("A3").Select
    Selection.End(xlDown).Select
    LastRow = ActiveCell.Row                    ' last row on report page
    
    Sheets("Data").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    LastRow2 = ActiveCell.Row                   ' last row on data page
    
    
    For ReportRow = 4 To LastRow                ' loop through each manager
        ReviewsOut = 0
        PDPsOut = 0
        Staff = 0                               ' reset data values to 0
                   
              
        Sheets("Report").Select
        
        Manager = Range("A" & ReportRow).Value  ' manager name stored
        
        Sheets("Data").Select
        
            For DataRow = 2 To LastRow2         ' loop through each line on data page
                If Range("Q" & DataRow).Value = Manager Then
                    Staff = Staff + 1           ' counts number of staff for this manager
                End If
                If Range("X" & DataRow).Value < ReviewDate And Range("Q" & DataRow).Value = Manager Then
                    ReviewsOut = ReviewsOut + 1 ' Count if last review older than review date
                End If
                If Range("Y" & DataRow).Value < ReviewDate And Range("Q" & DataRow).Value = Manager Then
                    PDPsOut = PDPsOut + 1       ' count if last PDP date older than review date
                End If
            Next DataRow
                
                '' All data for this manager will now be stored in the variables
                '' The following code enters the figures on the report page
                
                    Sheets("Report").Select
                    Range("B" & ReportRow).Value = Staff
                    Range("C" & ReportRow).Value = ReviewsOut
                    Range("F" & ReportRow).Value = PDPsOut
                   
                    
      Next ReportRow
    
    Application.Cursor = xlDefault
    Application.StatusBar = False
    Application.ScreenUpdating = True
    
    
End Sub

Each ReportRow is a manager's name. There are ~600 of them.
Each DataRow is a staff member's details (name, last review, managers name etc). There are ~17000 of them

The code loops down each manager name on the report page, collects info about their staff from the data page, then enters these figures next to the manager name on the report page.

Is there anything I am missing that would make this code run faster? I would rather not go back to having thousands of countif forumulas

Thanks

 

[Stiuart_W]

What I would suggest you do is this:-

1) Add a helper column in sheet "Report" and against each Manager name assign a number starting at 1 then 2 for the next to 600 or so

2) In your macro dimension an array, say ManagerList(1000,3)

3) Select the "report sheet" run your loop and assign each manager name to an element in the array, so ManagerList(1,1) = A4, ManagerList(2,1) and so on (BTW the array elements start at 0,0 but honestly I can never get my head around that!)

4) Then go to your data sheet and loop each line of data
4a) Do a Vlookup of Manager name in "Report" sheet and return the number in the helper column you created and update the array values
5) Close loop

6) Run another loop on Report sheet to write the array data back to the cells


Shouldn't be too hard and I think it should be faster

 

[Norie]

Have you tried setting calculation to manual while the code is running?

That should speed things up.

Another thing that would speed things up would be to stop moving between sheets multiple times throughout the code.

Option Explicit

Sub CountThings()
Dim wsReport As Worksheet
Dim wsData As Worksheet
Dim Staff As Long
Dim ReviewsOut As Long
Dim PDPsOut As Long
Dim ReportRow As Long
Dim DataRow As Long
Dim LastRow As Long
Dim LastRow2 As Long
Dim Manager As String
Dim ReviewDate As Date

    Application.ScreenUpdating = False
    Application.Cursor = xlWait
    Application.DisplayStatusBar = True
    Application.StatusBar = "Calculating..."
    Application.Calculation = xlCalculationManual

    Set wsReport = Sheets("Report")
    Set wsData = Sheets("Data")
    ReviewDate = wsReport.Range("B1").Value              ' review date stored

    LastRow = wsReport.Range("A" & Rows.Count).End(xlUp).Row

    LastRow2 = wsData.Range("A" & Rows.Count).End(xlUp).Row    ' last row on data page


    For ReportRow = 4 To LastRow                ' loop through each manager
        ReviewsOut = 0
        PDPsOut = 0
        Staff = 0                               ' reset data values to 0

        Manager = wsReport.Range("A" & ReportRow).Value  ' manager name stored

        With wsData

            For DataRow = 2 To LastRow2         ' loop through each line on data page
                If .Range("Q" & DataRow).Value = Manager Then
                    Staff = Staff + 1           ' counts number of staff for this manager
                End If
                If .Range("X" & DataRow).Value < ReviewDate And .Range("Q" & DataRow).Value = Manager Then
                    ReviewsOut = ReviewsOut + 1    ' Count if last review older than review date
                End If
                If .Range("Y" & DataRow).Value < ReviewDate And .Range("Q" & DataRow).Value = Manager Then
                    PDPsOut = PDPsOut + 1       ' count if last PDP date older than review date
                End If
            Next DataRow

            '' All data for this manager will now be stored in the variables
            '' The following code enters the figures on the report page
        End With

        With wsReport
            .Range("B" & ReportRow).Value = Staff
            .Range("C" & ReportRow).Value = ReviewsOut
            .Range("F" & ReportRow).Value = PDPsOut
        End With

    Next ReportRow

    Application.Cursor = xlDefault
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

PS You shouldn't use Count as the name of the sub, Count is a property of a lot of different things in VBA.