You are here:

Excel/Autofilter using VBA

Advertisement


Question
I have the following code below to filter through 100,000 rows and 32 columns. The code I have so far is only for the 16 of the 32 columns and it takes a lot of time to perform the macro. Is there a way to speed this up?

Sub EvaluatePigData()
'Scan Data Worksheet for 5 levels of criteria
'Level 1 = US thickness and MF signal are in acceptable range.
'Level 2 = Either the US thickness or MF signal are in the concern range.
'Level 3 = There are multiple level 2 events in adjacent locations.
'Level 4 = Both the US thickness and MF signal are in the concern range for the same channel number and location.
'Level 5 = There are multiplke level 4 events in adjacent locations.

Dim MF As Integer
Dim US As Integer
Dim rng As Range
   Set rng = Application.Range("B:AH")

'Test for Level 1 Conditions
If MF <= 25# And US >= 9# Then
   Answer = True
Else
'Test for Welds
   If MF > 97.99 And US > 12.5 Then
       Answer = True
   Else
'Test for Level 2 conditions
       If MF > 25# And MF <= 97.99 And US < 9# Then
         Answer = True
       Else
         Application.Goto Reference:="R6C2:R100005C17"
         Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
         Formula1:="=25.0000000001", Formula2:="=97.9999999999"
         Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
         With Selection.FormatConditions(1).Font
         .Bold = True
         .Italic = False
         .Color = -16776961
         .TintAndShade = 0
         End With
         With Selection.FormatConditions(1).Interior
         .Pattern = xlPatternLinearGradient
         .Gradient.Degree = 90
         .Gradient.ColorStops.Clear
         End With
         With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = 0
         End With
         With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0.5)
         .Color = 16038654
         .TintAndShade = 0
         End With
         With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = 0
         End With
         Selection.FormatConditions(1).StopIfTrue = False
         Application.Goto Reference:="R6C19:R100005C34"
         Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
         Formula1:="=9"
         Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
         With Selection.FormatConditions(1).Font
         .Bold = True
         .Italic = False
         .Color = -16776961
         .TintAndShade = 0
         End With
         With Selection.FormatConditions(1).Interior
         .Pattern = xlPatternLinearGradient
         .Gradient.Degree = 90
         .Gradient.ColorStops.Clear
         End With
         With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = 0
         End With
         With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0.5)
         .Color = 16038654
         .TintAndShade = 0
         End With
         With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = 0
         End With
         Selection.FormatConditions(1).StopIfTrue = False
         Application.Goto Reference:="R5C2"
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=2, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A945:Q95554").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         Range("A7").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("C5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=3, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A1007:Q96911").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=27
         Range("A37:Q37").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("D5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=4, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A6150:Q99366").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=39
         Range("A78:Q78").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Sheets("20130319 data").Select
         ActiveWindow.SmallScroll Down:=9
         ActiveWindow.ScrollRow = 6114
         ActiveWindow.ScrollRow = 5917
         ActiveWindow.ScrollRow = 1
         Sheets("20130319 data").Select
         Range("E5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=5, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A4138:Q99881").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=42
         Range("A117").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Range("F5").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=6, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A5931:Q98864").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=33
         Range("A154").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("G5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=7, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A2593:Q90908").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=33
         Range("A186").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("H5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=8, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A6436:Q89497").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=39
         Range("A226").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("I5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=9, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A3530:Q99964").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=18
         Range("A249").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("J5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=10, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A1489:P95214").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=45
         Range("A282").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("K5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=11, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A7884:Q99952").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=27
         Range("A310").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("L5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=12, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A3472:Q94905").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         Range("A325").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("M5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=13, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A2963:Q98584").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=45
         Range("A361").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("N5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=14, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A2338:Q93802").Select
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=39
         Range("A397:Q397").Select
         Sheets("20130319 data").Select
         Selection.Copy
         ActiveWindow.SmallScroll Down:=-27
         Sheets("Level 2-5 Report").Select
         ActiveSheet.Paste
         ActiveWindow.SmallScroll Down:=3
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("O5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=15, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A1190:Q99457").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=21
         Range("A428").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("P6").Select
         Range("P5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=16, Criteria1:= _
         ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A2373:Q98304").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=48
         Range("A469").Select
         ActiveSheet.Paste
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Range("Q5").Select
         Selection.AutoFilter
         ActiveSheet.Range("$A$5:$Q$100005").AutoFilter Field:=17, Criteria1:= _
         ">25.0000000001", Operator:=xlAnd, Criteria2:="<=97.9999999999"
         Range("A2407:Q93776").Select
         Selection.Copy
         Sheets("Level 2-5 Report").Select
         ActiveWindow.SmallScroll Down:=27
         Range("A500").Select
         ActiveSheet.Paste
         ActiveWindow.SmallScroll Down:=-18
         Sheets("20130319 data").Select
         Application.CutCopyMode = False
         Selection.AutoFilter
         Sheets("Level 2-5 Report").Select
         ActiveWindow.ScrollRow = 468
         ActiveWindow.ScrollRow = 466
         ActiveWindow.ScrollRow = 464
         ActiveWindow.ScrollRow = 461
         ActiveWindow.ScrollRow = 458
         ActiveWindow.ScrollRow = 447
         ActiveWindow.ScrollRow = 403
         ActiveWindow.ScrollRow = 354
         ActiveWindow.ScrollRow = 245
         ActiveWindow.ScrollRow = 147
         ActiveWindow.ScrollRow = 65
         ActiveWindow.ScrollRow = 1
         Selection.AutoFilter
         Range("A6").Select
         Selection.AutoFilter
         ActiveWorkbook.Worksheets("Level 2-5 Report").AutoFilter.Sort.SortFields.Clear
         ActiveWorkbook.Worksheets("Level 2-5 Report").AutoFilter.Sort.SortFields.Add _
         Key:=Range("A6:A531"), SortOn:=xlSortOnValues, Order:=xlAscending, _
         DataOption:=xlSortNormal
         With ActiveWorkbook.Worksheets("Level 2-5 Report").AutoFilter.Sort
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
         End With
       End If
   End If
End If

End Sub

Answer
Hi Stephen,

Without analysing your macro, one way to speed things up is to turn off screenupdating and calcualtion at the start of the code and turn it back on afterwards:

Applictaion.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Your code goes here
Applictaion.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Jan Karel Pieterse

Expertise

Excel and Excel/VBA questions

Experience

Excel MVP

Organizations
Self employed Excel developer

Education/Credentials
Bachelor in Chemical Engineering

Awards and Honors
Microsoft MVP award since 2002

Past/Present Clients
Shell, Fortis bank, ABN-AMRO bank, Morgan Stanley, ...

©2016 About.com. All rights reserved.