VBA autofilter loop running too slowly

[WolfOctober]

Hi everybody,

Through trial-and-error, I have determined that the following section of my larger code is causing my overall macro to run really slowly:

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

'Populating "HBsAg" with Average % IRR data    For j = 7 To 157
        For i = 1 To 77
            With Sheets("HBsAg")
                Sheets("Data Sheet").Select
                Columns("E:I").AutoFilter
                Sheets("Data Sheet").Range("E:I").AutoFilter Field:=3, Criteria1:="HBsAg"
                Sheets("Data Sheet").Range("E:I").AutoFilter Field:=1, Criteria1:=.Cells(j, 2)
                Sheets("Data Sheet").Range("E:I").AutoFilter Field:=5, Operator:=xlFilterValues, Criteria2:=Array(2, .Cells(6, i + 2))
                Dim filter_rng As Range
                Dim rw As Range
                Dim last_row As Long
                last_row = Cells(Rows.Count, "K").End(xlUp).Row
                Set filter_rng = Sheets("Data Sheet").Range("J1:K" & last_row)
                For Each rw In filter_rng.SpecialCells(xlCellTypeVisible)
                    Sheets("Test").Range("A" & rw.Row).Value = Sheets("Data Sheet").Range("J" & rw.Row).Value
                    Sheets("Test").Range("B" & rw.Row).Value = Sheets("Data Sheet").Range("K" & rw.Row).Value
                Next rw
                Worksheets("Data Sheet").AutoFilterMode = False
                If WorksheetFunction.CountA(Sheets("Test").Cells) = 0 Then
                    .Cells(j, i + 2) = vbNullString
                Else
                    .Cells(j, i + 2) = Application.WorksheetFunction.Sum(Sheets("Test").Columns("B:B")) / Application.WorksheetFunction.Sum(Sheets("Test").Columns("A:A")) * 100
                    .Cells(j, i + 2).NumberFormat = "0.000"
                End If
                Sheets("Test").Cells.Clear
            End With
        Next i
    Next j

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

Basically, here's what the loop does --
1) Based on values in the "HBsAg" worksheet, the loop applies a unique autofilter to the "Data Sheet" worksheet
2) Transfers that filtered data into the "Test" worksheet
3) Runs a calculation (dividing the sum of one column by another) on that data that was just transferred to "Test"...
4) ...And prints (and formats) the result of that into the corresponding (based on the autofilters applied in Step 1) cell in "HBsAg"

When I run the macro, it takes 20 minutes to complete...

Is it because there are basically 10,000+ autofilters being applied to "Data Sheet" throughout the course of the loop? Could it be something else that's slowing things down? What can I do to speed things up?

Thanks in advance for any help you can give me!

 

[ukmikeb]

Hi

Possibly this statement :-

                    .Cells(j, i + 2) = Application.WorksheetFunction.Sum(Sheets("Test").Columns("B:B")) / Application.WorksheetFunction.Sum(Sheets("Test").Columns("A:A")) * 100

Try to limit this calculation to the number of used rows.

hth

 

[RoryA]

Please stick to one thread: https://www.mrexcel.com/forum/excel...s-pastes-filtered-data-another-worksheet.html

Thread closed.