Speed up VBA Autofilter

S

steveo0707

Board Regular
Joined
Mar 4, 2013
Messages
71
Office Version
  1. 365
Platform
  1. Windows
I have the following VBA code in an Excel spreadsheet and I need to see if there is a way to re-write to speed up the macro. It takes over a 1/2 hour to run it know.

Code: 
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
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
S

s hal

Board Regular
Joined
Apr 10, 2013
Messages
198
I don't see anything about this that would take so long to run. Are you doing this in a formula-intensive workbook that is recalculating every time you filter? Perhaps turning off calculation while you do the filtering and pasting would speed things up dramatically.

Failing that, its hard to sift through your code - looks like you used the macro recorder and have a lot of extra fluff masking the important stuff :(
 
Upvote 0
G

Garry2Rs

Board Regular
Joined
Apr 10, 2013
Messages
55
Well.., as already mentioned it's apparent that the macro recorder default behavior is causing the slowness.

I don't see where your variables 'MF' and 'US' get initialized with values and so the last 'Else' clause will always execute.

Here's my cleaned up version of what I think will work...

Code: 
Sub EvaluatePigData_v2()
'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%, US%
  Dim wksSource As Worksheet, wksTarget As Worksheet, bAnswer As Boolean
  Set wksSource = Sheets("20130319 data"): Set wksTarget = wksTarget

  'Test for Level 1 Conditions
  If MF <= 25# And US >= 9# Then
      bAnswer = True
  Else
    'Test for Welds
    If MF > 97.99 And US > 12.5 Then
        bAnswer = True
    Else
      'Test for Level 2 conditions
      If MF > 25# And MF <= 97.99 And US < 9# Then
        bAnswer = True
      Else
        With wksSource
          With .Range("$B$6:$Q$100005", "$S$6:$AH$100005")
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
              Formula1:="=25.0000000001", Formula2:="=97.9999999999"
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Font
                .Bold = True: .Italic = False: .Color = -16776961: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior
                .Pattern = xlPatternLinearGradient: .Gradient.Degree = 90: .Gradient.ColorStops.Clear
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0.5)
                .Color = 16038654: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
                .ThemeColor = xlThemeColorDark1: .TintAndShade = 0
            End With
            .FormatConditions(1).StopIfTrue = False
          End With 'Range("$B$6:$Q$100005", "$S$6:$AH$100005")
        
          .Range("$B$5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=2, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A945:Q95554").Copy Destination:=wksTarget.Range("A7")
          
          .AutoFilter: .Range("C5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=3, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1007:Q96911").Copy Destination:=wksTarget.Range("A37:Q37")
        
          .AutoFilter: .Range("D5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=4, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A6150:Q99366").Copy Destination:=wksTarget.Range("A78:Q78")
        
          .AutoFilter: Range("E5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=5, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A4138:Q99881").Copy Destination:=wksTarget.Range("A117")
          
          .AutoFilter: .Range("F5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=6, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A5931:Q98864").Copy Destination:=wksTarget.Range("A154")
          
          .AutoFilter: .Range("G5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=7, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2593:Q90908").Copy Destination:=wksTarget.Range("A186")
          
          .AutoFilter: .Range("H5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=8, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A6436:Q89497").Copy Destination:=wksTarget.Range("A226")
          
          .AutoFilter: .Range("I5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=9, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A3530:Q99964").Copy Destination:=wksTarget.Range("A249")
          
          .AutoFilter: .Range("J5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=10, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1489:P95214").Copy Destination:=wksTarget.Range("A282")
          
          .AutoFilter: .Range("K5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=11, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A7884:Q99952").Copy Destination:=wksTarget.Range("A310")
          
          .AutoFilter: .Range("L5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=12, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A3472:Q94905").Copy Destination:=wksTarget.Range("A325")
          
          .AutoFilter: .Range("M5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=13, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2963:Q98584").Copy Destination:=wksTarget.Range("A361")
          
          .AutoFilter: .Range("N5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=14, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2338:Q93802").Copy Destination:=wksTarget.Range("A397:Q397")
          
          .AutoFilter: .Range("O5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=15, Criteria1:= _
              ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1190:Q99457").Copy Destination:=wksTarget.Range("A428")
          
          .AutoFilter: .Range("P5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=16, Criteria1:= _
              ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2373:Q98304").Copy Destination:=wksTarget.Range("A469")
          
          .AutoFilter: .Range("Q5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=17, Criteria1:=">25.0000000001", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          Range("A2407:Q93776").Copy Destination:=wksTarget.Range("A500")
          .AutoFilter
          
          With wksTarget
            .Select: ActiveWindow.ScrollRow = 1
            .AutoFilter: .Range("A6").AutoFilter
          End With 'wksTarget
        End With 'Sheets("20130319 data")
        
        With wksTarget.AutoFilter.Sort
          .SortFields.Clear: .SortFields.Add _
            Key:=Range("A6:A531"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          .Header = xlYes: .MatchCase = False: .Orientation = xlTopToBottom: .SortMethod = xlPinYin
          .Apply
        End With 'wksTarget.AutoFilter.Sort
      End If 'MF > 25# And MF <= 97.99 And US < 9#
    End If 'MF > 97.99 And US > 12.5
  End If 'MF <= 25# And US >= 9#
  'Cleanup
  Set wksSource = Nothing: Set wksTarget = Nothing
End Sub
 
Last edited:
Upvote 0
G

Garry2Rs

Board Regular
Joined
Apr 10, 2013
Messages
55
Oops! A few issues needed to be fixed...

Code: 
Sub EvaluatePigData_v2()
'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%, US%
  Dim wksSource As Worksheet, wksTarget As Worksheet, bAnswer As Boolean
  Set wksSource = Sheets("20130319 data"): Set wksTarget = wksTarget

  'Test for Level 1 Conditions
  If MF <= 25# And US >= 9# Then
      bAnswer = True
  Else
    'Test for Welds
    If MF > 97.99 And US > 12.5 Then
        bAnswer = True
    Else
      'Test for Level 2 conditions
      If MF > 25# And MF <= 97.99 And US < 9# Then
        bAnswer = True
      Else
        With wksSource
          With .Range("$B$6:$Q$100005", "$S$6:$AH$100005")
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
              Formula1:="=25.0000000001", Formula2:="=97.9999999999"
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Font
                .Bold = True: .Italic = False: .Color = -16776961: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior
                .Pattern = xlPatternLinearGradient: .Gradient.Degree = 90: .Gradient.ColorStops.Clear
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0.5)
                .Color = 16038654: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
                .ThemeColor = xlThemeColorDark1: .TintAndShade = 0
            End With
            .FormatConditions(1).StopIfTrue = False
          End With 'Range("$B$6:$Q$100005", "$S$6:$AH$100005")
        
          .Range("$B$5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=2, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A945:Q95554").Copy Destination:=wksTarget.Range("A7")
          
          .AutoFilter: .Range("C5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=3, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1007:Q96911").Copy Destination:=wksTarget.Range("A37:Q37")
        
          .AutoFilter: .Range("D5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=4, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A6150:Q99366").Copy Destination:=wksTarget.Range("A78:Q78")
        
          .AutoFilter: Range("E5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=5, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A4138:Q99881").Copy Destination:=wksTarget.Range("A117")
          
          .AutoFilter: .Range("F5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=6, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A5931:Q98864").Copy Destination:=wksTarget.Range("A154")
          
          .AutoFilter: .Range("G5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=7, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2593:Q90908").Copy Destination:=wksTarget.Range("A186")
          
          .AutoFilter: .Range("H5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=8, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A6436:Q89497").Copy Destination:=wksTarget.Range("A226")
          
          .AutoFilter: .Range("I5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=9, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A3530:Q99964").Copy Destination:=wksTarget.Range("A249")
          
          .AutoFilter: .Range("J5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=10, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1489:P95214").Copy Destination:=wksTarget.Range("A282")
          
          .AutoFilter: .Range("K5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=11, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A7884:Q99952").Copy Destination:=wksTarget.Range("A310")
          
          .AutoFilter: .Range("L5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=12, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A3472:Q94905").Copy Destination:=wksTarget.Range("A325")
          
          .AutoFilter: .Range("M5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=13, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2963:Q98584").Copy Destination:=wksTarget.Range("A361")
          
          .AutoFilter: .Range("N5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=14, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2338:Q93802").Copy Destination:=wksTarget.Range("A397:Q397")
          
          .AutoFilter: .Range("O5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=15, Criteria1:= _
              ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1190:Q99457").Copy Destination:=wksTarget.Range("A428")
          
          .AutoFilter: .Range("P5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=16, Criteria1:= _
              ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2373:Q98304").Copy Destination:=wksTarget.Range("A469")
          
          .AutoFilter: .Range("Q5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=17, Criteria1:=">25.0000000001", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2407:Q93776").Copy Destination:=wksTarget.Range("A500")
          .AutoFilter
        End With 'wksSource
          
        With wksTarget
          .Select: ActiveWindow.ScrollRow = 1
          .AutoFilter: .Range("A6").AutoFilter
          With .AutoFilter.Sort
            .SortFields.Clear: .SortFields.Add _
              Key:=Range("A6:A531"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes: .MatchCase = False: .Orientation = xlTopToBottom: .SortMethod = xlPinYin
            .Apply
          End With '.AutoFilter.Sort
        End With 'wksTarget
        
      End If 'MF > 25# And MF <= 97.99 And US < 9#
    End If 'MF > 97.99 And US > 12.5
  End If 'MF <= 25# And US >= 9#
  
  'Cleanup
  Set wksSource = Nothing: Set wksTarget = Nothing
End Sub
 
Upvote 0
S

steveo0707

Board Regular
Joined
Mar 4, 2013
Messages
71
Office Version
  1. 365
Platform
  1. Windows
ADVERTISEMENT
Hello Garry2Sr,

Thanks for cleaning things up. It is a lot faster now.

Thank you for your time!
 
Upvote 0
S

steveo0707

Board Regular
Joined
Mar 4, 2013
Messages
71
Office Version
  1. 365
Platform
  1. Windows
Hello s hal,

No formulas in this spreadsheet. I did check to if calculation was running thanks to your suggestion.

Thank you for your time!
 
Upvote 0
G

Garry2Rs

Board Regular
Joined
Apr 10, 2013
Messages
55
You're welcome!

You can improve on performance even further by implementing the following reusable procedure...

In a standard module:
Code: 
Option Explicit

Type udtAppModes
  Events As Boolean: CalcMode As Long: Display As Boolean: RunFast As Boolean
End Type
Public AppMode As udtAppModes


Public Sub EnableFastCode(Optional SetFast As Boolean = True)
  'Make sure we're not already enabled/disabled elsewhere
  If AppMode.RunFast = SetFast Then Exit Sub
  With Application
    If SetFast Then
      AppMode.Display = .ScreenUpdating: .ScreenUpdating = False
      AppMode.CalcMode = .Calculation: .Calculation = xlCalculationManual
      AppMode.Events = .EnableEvents: .EnableEvents = False
      AppMode.RunFast = True
    Else
      .ScreenUpdating = AppMode.Display: .Calculation = AppMode.CalcMode
      .EnableEvents = AppMode.Events: AppMode.RunFast = False
    End If
  End With
End Sub

..and use it as follows...

Code: 
Sub EvaluatePigData_v2()
'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%, US%
  Dim wksSource As Worksheet, wksTarget As Worksheet, bAnswer As Boolean
  Set wksSource = Sheets("20130319 data"): Set wksTarget = wksTarget

  'Test for Level 1 Conditions
  If MF <= 25# And US >= 9# Then
      bAnswer = True
  Else
    'Test for Welds
    If MF > 97.99 And US > 12.5 Then
        bAnswer = True
    Else
      'Test for Level 2 conditions
      If MF > 25# And MF <= 97.99 And US < 9# Then
        bAnswer = True
      Else
        On Error GoTo Cleanup
        EnableFastCode
        With wksSource
          With .Range("$B$6:$Q$100005", "$S$6:$AH$100005")
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
              Formula1:="=25.0000000001", Formula2:="=97.9999999999"
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Font
                .Bold = True: .Italic = False: .Color = -16776961: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior
                .Pattern = xlPatternLinearGradient: .Gradient.Degree = 90: .Gradient.ColorStops.Clear
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0.5)
                .Color = 16038654: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
                .ThemeColor = xlThemeColorDark1: .TintAndShade = 0
            End With
            .FormatConditions(1).StopIfTrue = False
          End With 'Range("$B$6:$Q$100005", "$S$6:$AH$100005")
        
          .Range("$B$5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=2, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A945:Q95554").Copy Destination:=wksTarget.Range("A7")
          
          .AutoFilter: .Range("C5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=3, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1007:Q96911").Copy Destination:=wksTarget.Range("A37:Q37")
        
          .AutoFilter: .Range("D5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=4, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A6150:Q99366").Copy Destination:=wksTarget.Range("A78:Q78")
        
          .AutoFilter: Range("E5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=5, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A4138:Q99881").Copy Destination:=wksTarget.Range("A117")
          
          .AutoFilter: .Range("F5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=6, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A5931:Q98864").Copy Destination:=wksTarget.Range("A154")
          
          .AutoFilter: .Range("G5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=7, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2593:Q90908").Copy Destination:=wksTarget.Range("A186")
          
          .AutoFilter: .Range("H5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=8, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A6436:Q89497").Copy Destination:=wksTarget.Range("A226")
          
          .AutoFilter: .Range("I5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=9, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A3530:Q99964").Copy Destination:=wksTarget.Range("A249")
          
          .AutoFilter: .Range("J5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=10, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1489:P95214").Copy Destination:=wksTarget.Range("A282")
          
          .AutoFilter: .Range("K5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=11, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A7884:Q99952").Copy Destination:=wksTarget.Range("A310")
          
          .AutoFilter: .Range("L5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=12, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A3472:Q94905").Copy Destination:=wksTarget.Range("A325")
          
          .AutoFilter: .Range("M5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=13, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2963:Q98584").Copy Destination:=wksTarget.Range("A361")
          
          .AutoFilter: .Range("N5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=14, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2338:Q93802").Copy Destination:=wksTarget.Range("A397:Q397")
          
          .AutoFilter: .Range("O5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=15, Criteria1:= _
              ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1190:Q99457").Copy Destination:=wksTarget.Range("A428")
          
          .AutoFilter: .Range("P5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=16, Criteria1:= _
              ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2373:Q98304").Copy Destination:=wksTarget.Range("A469")
          
          .AutoFilter: .Range("Q5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=17, Criteria1:=">25.0000000001", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2407:Q93776").Copy Destination:=wksTarget.Range("A500")
          .AutoFilter
        End With 'wksSource
          
        With wksTarget
          .Select: ActiveWindow.ScrollRow = 1
          .AutoFilter: .Range("A6").AutoFilter
          With .AutoFilter.Sort
            .SortFields.Clear: .SortFields.Add _
              Key:=Range("A6:A531"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes: .MatchCase = False: .Orientation = xlTopToBottom: .SortMethod = xlPinYin
            .Apply
          End With '.AutoFilter.Sort
        End With 'wksTarget
        
      End If 'MF > 25# And MF <= 97.99 And US < 9#
    End If 'MF > 97.99 And US > 12.5
  End If 'MF <= 25# And US >= 9#
  
Cleanup:
  EnableFastCode False
  Set wksSource = Nothing: Set wksTarget = Nothing
End Sub

Just make sure the settings are how you want them normally so those are what 'EnableFastCode' stores for resetting when done.
 
Last edited:
Upvote 0
S

steveo0707

Board Regular
Joined
Mar 4, 2013
Messages
71
Office Version
  1. 365
Platform
  1. Windows
Hello Garry2Rs,

Sorry It took so long to get back to you. I tried using the second code below to speed things and It says that
Enable fast code is not defined when I try to run it. Do I have to define this some how?



Garry2Rs said:
You're welcome!

You can improve on performance even further by implementing the following reusable procedure...

In a standard module:
Code: 
Option Explicit

Type udtAppModes
  Events As Boolean: CalcMode As Long: Display As Boolean: RunFast As Boolean
End Type
Public AppMode As udtAppModes


Public Sub EnableFastCode(Optional SetFast As Boolean = True)
  'Make sure we're not already enabled/disabled elsewhere
  If AppMode.RunFast = SetFast Then Exit Sub
  With Application
    If SetFast Then
      AppMode.Display = .ScreenUpdating: .ScreenUpdating = False
      AppMode.CalcMode = .Calculation: .Calculation = xlCalculationManual
      AppMode.Events = .EnableEvents: .EnableEvents = False
      AppMode.RunFast = True
    Else
      .ScreenUpdating = AppMode.Display: .Calculation = AppMode.CalcMode
      .EnableEvents = AppMode.Events: AppMode.RunFast = False
    End If
  End With
End Sub

..and use it as follows...

Code: 
Sub EvaluatePigData_v2()
'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%, US%
  Dim wksSource As Worksheet, wksTarget As Worksheet, bAnswer As Boolean
  Set wksSource = Sheets("20130319 data"): Set wksTarget = wksTarget

  'Test for Level 1 Conditions
  If MF <= 25# And US >= 9# Then
      bAnswer = True
  Else
    'Test for Welds
    If MF > 97.99 And US > 12.5 Then
        bAnswer = True
    Else
      'Test for Level 2 conditions
      If MF > 25# And MF <= 97.99 And US < 9# Then
        bAnswer = True
      Else
        On Error GoTo Cleanup
        EnableFastCode
        With wksSource
          With .Range("$B$6:$Q$100005", "$S$6:$AH$100005")
            .FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
              Formula1:="=25.0000000001", Formula2:="=97.9999999999"
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Font
                .Bold = True: .Italic = False: .Color = -16776961: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior
                .Pattern = xlPatternLinearGradient: .Gradient.Degree = 90: .Gradient.ColorStops.Clear
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0.5)
                .Color = 16038654: .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
                .ThemeColor = xlThemeColorDark1: .TintAndShade = 0
            End With
            .FormatConditions(1).StopIfTrue = False
          End With 'Range("$B$6:$Q$100005", "$S$6:$AH$100005")
        
          .Range("$B$5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=2, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A945:Q95554").Copy Destination:=wksTarget.Range("A7")
          
          .AutoFilter: .Range("C5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=3, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1007:Q96911").Copy Destination:=wksTarget.Range("A37:Q37")
        
          .AutoFilter: .Range("D5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=4, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A6150:Q99366").Copy Destination:=wksTarget.Range("A78:Q78")
        
          .AutoFilter: Range("E5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=5, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A4138:Q99881").Copy Destination:=wksTarget.Range("A117")
          
          .AutoFilter: .Range("F5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=6, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A5931:Q98864").Copy Destination:=wksTarget.Range("A154")
          
          .AutoFilter: .Range("G5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=7, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2593:Q90908").Copy Destination:=wksTarget.Range("A186")
          
          .AutoFilter: .Range("H5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=8, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A6436:Q89497").Copy Destination:=wksTarget.Range("A226")
          
          .AutoFilter: .Range("I5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=9, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A3530:Q99964").Copy Destination:=wksTarget.Range("A249")
          
          .AutoFilter: .Range("J5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=10, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1489:P95214").Copy Destination:=wksTarget.Range("A282")
          
          .AutoFilter: .Range("K5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=11, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A7884:Q99952").Copy Destination:=wksTarget.Range("A310")
          
          .AutoFilter: .Range("L5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=12, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A3472:Q94905").Copy Destination:=wksTarget.Range("A325")
          
          .AutoFilter: .Range("M5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=13, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2963:Q98584").Copy Destination:=wksTarget.Range("A361")
          
          .AutoFilter: .Range("N5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=14, Criteria1:=">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2338:Q93802").Copy Destination:=wksTarget.Range("A397:Q397")
          
          .AutoFilter: .Range("O5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=15, Criteria1:= _
              ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A1190:Q99457").Copy Destination:=wksTarget.Range("A428")
          
          .AutoFilter: .Range("P5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=16, Criteria1:= _
              ">25.0000000000", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2373:Q98304").Copy Destination:=wksTarget.Range("A469")
          
          .AutoFilter: .Range("Q5").AutoFilter
          .Range("$A$5:$Q$100005").AutoFilter _
            Field:=17, Criteria1:=">25.0000000001", Operator:=xlAnd, Criteria2:="<=97.9999999999"
          .Range("A2407:Q93776").Copy Destination:=wksTarget.Range("A500")
          .AutoFilter
        End With 'wksSource
          
        With wksTarget
          .Select: ActiveWindow.ScrollRow = 1
          .AutoFilter: .Range("A6").AutoFilter
          With .AutoFilter.Sort
            .SortFields.Clear: .SortFields.Add _
              Key:=Range("A6:A531"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes: .MatchCase = False: .Orientation = xlTopToBottom: .SortMethod = xlPinYin
            .Apply
          End With '.AutoFilter.Sort
        End With 'wksTarget
        
      End If 'MF > 25# And MF <= 97.99 And US < 9#
    End If 'MF > 97.99 And US > 12.5
  End If 'MF <= 25# And US >= 9#
  
Cleanup:
  EnableFastCode False
  Set wksSource = Nothing: Set wksTarget = Nothing
End Sub

Just make sure the settings are how you want them normally so those are what 'EnableFastCode' stores for resetting when done.
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
Changing recorded macro when trying to format a sheet - Need dynamic selection of cells
Replies
2
Views
176
nidhinair22
N
S
  • Question
Can I combine these small macros into one big macro?
Replies
4
Views
175
johnnyL
J
A
  • Solved
Move between workbooks error
Replies
3
Views
117
Joe4
Joe4
P
  • Question
VBA not excluding specific data based on text
Replies
1
Views
97
Rijnsent
Rijnsent
A
  • Question
VBA macro to format excel worksheet.
Replies
1
Views
342
HaHoBe
HaHoBe

Forum statistics

Threads
1,195,631
Messages
6,010,783
Members
441,569
Latest member
PeggyLee

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top