filtering during vba take way to long

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
439
Office Version
  1. 2016
Hey all

I have a lot of toruble with this code. I have tried turning off automatic calculations and it does not run right. It slows down when I do the Autofilter and just takes forever. I am not sure what is going on. Any ideas would be appreciated! It seems like it might have some ghost rows or something but I am not sure.

Jordan


VBA Code:
Sub COSARFINALCOPYPASTE12121()
'
' COSARFINALCOPYPASTE12121 Macro
'

'
Sheets("CO SAR").Select
Dim Xrow As Long, ws As Worksheet, dng As Range, dng1 As Range, dng2 As Range, dng3 As Range, dng4 As Range, dng5 As Range, dng6 As Range, dng7 As Range, dng8 As Range, dng9 As Range, dng10 As Range, dng11 As Range, dng12 As Range
    Xrow = Cells(Rows.Count, "F").End(xlUp).Row
'Dim ThisWorkbook.Worksheets("Variables").Range("A1").Value As String
Dim fn10 As String

    With ActiveSheet
    Set ws = ActiveSheet
    
    Set dng = .Range("V2:V" & Xrow)
    Set dng1 = .Range("V2:V" & Xrow)
    Set dng2 = .Range("W2:W" & Xrow)
    Set dng3 = .Range("X2:X" & Xrow)
     Set dng4 = .Range("Y2:Y" & Xrow)
      Set dng5 = .Range("Z2:Z" & Xrow)
       Set dng6 = .Range("AA2:AA" & Xrow)
        Set dng7 = .Range("AB2:AB" & Xrow)
         Set dng8 = .Range("AC2:AC" & Xrow)
          Set dng9 = .Range("AD2:AD" & Xrow)
           Set dng10 = .Range("AE2:AE" & Xrow)
            Set dng11 = .Range("AF2:AF" & Xrow)
            Set dng12 = .Range("T2:T" & Xrow)
    
'ThisWorkbook.Worksheets("Variables").Range("A1").Value = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
    fn10 = Mid(ThisWorkbook.Worksheets("Variables").Range("A1").Value, 4, 3)
'     Application.Calculation = xlManual
'
    Application.DisplayAlerts = False
  
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "97 Prior"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "97 Current"
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "21 Prior"
    Range("Y1").Select
    ActiveCell.FormulaR1C1 = "21 Current"
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "97 Vlookup"
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "21 Vlookup"
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "Helper1"
    Range("AC1").Select
    ActiveCell.FormulaR1C1 = "Helper2"
    Range("AD1").Select
    ActiveCell.FormulaR1C1 = "Helper3"
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = "Helper4"
    Range("AF1").Select
    ActiveCell.FormulaR1C1 = "Helper5"
    
    
    Dim fn4 As String
    Dim filepath As String
    Dim myfile As String
    
    fn4 = Right(ThisWorkbook.Worksheets("Variables").Range("A1").Value, 5)
filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & ThisWorkbook.Worksheets("Variables").Range("A4").Value & "\" & ThisWorkbook.Worksheets("Variables").Range("A1").Value & "\Field Detail Lines\"
'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
myfile = "CO09700 " & fn4 & ".xlsx"
 Dim strFileName As String
Dim strFileExists As String

    strFileName = filepath & myfile
    strFileExists = Dir(strFileName)

   If strFileExists = "" Then
             Sheets(ThisWorkbook.Worksheets("Variables").Range("A7").Value & ThisWorkbook.Worksheets("Variables").Range("A3").Value & " IDARRS").Select
    ActiveSheet.Range("$A$1:$AX$5000").AutoFilter Field:=1, Criteria1:="=97", _
        Operator:=xlOr, Criteria2:="="
    ActiveSheet.Range("$A$1:$AX$5000").AutoFilter Field:=8, Criteria1:=Array( _
        "IPAC", "MOCAS", "SOMARDS", "DDARS", "DLA EBS"), Operator:=xlFilterValues
   ActiveSheet.Range("$A$1:$AX$5000").AutoFilter Field:=9, Criteria1:=Array( _
        "6355", "6356", "6469", "6551"), Operator:=xlFilterValues
   
    ActiveSheet.Range("$A$1:$AX$5000").AutoFilter Field:=36, Criteria1:="="
    
    
    Range("aj2").Select
    dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Variance"
  
  Range("al2").Select
    dng2.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Variance"
  

    
    
    Else
    
     ActiveSheet.Range("$A$1:$U$60000").AutoFilter Field:=21, Criteria1:= _
        "=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a8").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a9").Value, 2) & ".xlsx", Operator:=xlOr, Criteria2:="=CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a8").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("A3").Value, 2) & ".xlsx"
        
        
        
         dng12.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+-RC[-2]"
        
    
    ActiveSheet.Range("$A$1:$U$60000").AutoFilter Field:=21, Criteria1:= _
        "=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 2) & ".xlsx", Operator:=xlOr, Criteria2:="=CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a3").Value, 2) & ".xlsx"
        
         
         dng12.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+RC[-2]"
        
    
    
    
    
    
    
    ActiveSheet.Range("$A$1:$U$60000").AutoFilter Field:=21, Criteria1:= _
        "=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a8").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a9").Value, 2) & ".xlsx", Operator:=xlOr, Criteria2:="=CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a8").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("A3").Value, 2) & ".xlsx"
        
        dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+-RC[-2]"
        
    
    ActiveSheet.Range("$A$1:$U$60000").AutoFilter Field:=21, Criteria1:= _
         "=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 2) & ".xlsx", Operator:=xlOr, Criteria2:="=CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a3").Value, 2) & ".xlsx"
        
         
        
        dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+RC[-2]"

   
    ActiveSheet.Range("$A$1:$U$60000").AutoFilter Field:=21
    
    
    
    
    
    Range("AG1").Select
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:= _
        "=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a8").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a9").Value, 2) & ".xlsx"
        
         
   
    dng1.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-9],RC[-4])"
  
  
  
   
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:= _
         "=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a3").Value, 2) & ".xlsx"
        
        
       
    dng2.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-10],RC[-5])"
  
   End If
   
  
  
  Dim fn5 As String
  Dim filepath2 As String
  Dim myfile2 As String
  
  
fn5 = Right(ThisWorkbook.Worksheets("Variables").Range("A1").Value, 5)
filepath2 = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & ThisWorkbook.Worksheets("Variables").Range("A4").Value & "\" & ThisWorkbook.Worksheets("Variables").Range("A1").Value & "\Field Detail Lines\"
'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
myfile2 = "CO21army" & fn5 & ".xlsx"
 
Dim strFileName2 As String
Dim strFileExists2 As String

    strFileName2 = filepath2 & myfile2
    strFileExists2 = Dir(strFileName2)

   If strFileExists2 = "" Then
           
           
                   Sheets(ThisWorkbook.Worksheets("Variables").Range("A7").Value & " " & ThisWorkbook.Worksheets("Variables").Range("A3").Value & " IDARRS").Select
    ActiveSheet.Range("$A$1:$AX$5000").AutoFilter Field:=1, Criteria1:="=21", _
        Operator:=xlOr, Criteria2:="="
    ActiveSheet.Range("$A$1:$AX$5000").AutoFilter Field:=8, Criteria1:=Array( _
        "IPAC", "MOCAS", "SOMARDS", "DDARS", "DLA EBS"), Operator:=xlFilterValues
   ActiveSheet.Range("$A$1:$AX$5000").AutoFilter Field:=9, Criteria1:=Array( _
        "6355", "6356", "6469", "6551"), Operator:=xlFilterValues
   
    ActiveSheet.Range("$A$1:$AX$5000").AutoFilter Field:=36, Criteria1:="="
    
    
    Range("aj2").Select
    dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Variance"
  
  Range("al2").Select
    dng2.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Variance"
           
           
    Else

   
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:= _
        "=CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a8").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("A3").Value, 2) & ".xlsx"
        
         dng3.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-11],RC[-6])"
   
        
    
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:= _
        "=CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("A3").Value, 2) & ".xlsx"
        
         dng4.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-12],RC[-7])"
    
        
    End If
        
'fn4 = Right(ThisWorkbook.Worksheets("Variables").Range("A1").Value, 5)
'filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & ThisWorkbook.Worksheets("Variables").Range("A4").Value & "\" & ThisWorkbook.Worksheets("Variables").Range("A1").Value & "\Field Detail Lines\"
''K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
'myfile = "CO09700 " & fn4 & ".xlsx"
' Dim strFileName As String
'Dim strFileExists As String
'
'    strFileName = filepath & myfile
'    strFileExists = Dir(strFileName)

   If strFileExists = "" Then
           MsgBox "The current month 97 CO SAR file does not exist"
           
    Else
    
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:= _
        "=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a8").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a9").Value, 2) & ".xlsx"
        
         dng5.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+VLOOKUP(RC[-4],C[-3],1,FALSE)"
            
    End If
    
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:= _
        "CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a8").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("A3").Value, 2) & ".xlsx"
        
        dng6.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+VLOOKUP(RC[-3],C[-2],1,FALSE)"
         
    
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21
    Range("AB2").Select
ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:= _
        "CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a7").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("A3").Value, 2) & ".xlsx"
        
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=16, Criteria1:=Array("" & ThisWorkbook.Worksheets("Variables").Range("a6").Value & "")
    Range("AB5").Select
    
     Range("ab2:ab60000").SpecialCells(xlCellTypeVisible).Formula = "X"

    
    
    
'
'fn4 = Right(ThisWorkbook.Worksheets("Variables").Range("A1").Value, 5)
'filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & ThisWorkbook.Worksheets("Variables").Range("A4").Value & "\" & ThisWorkbook.Worksheets("Variables").Range("A1").Value & "\Field Detail Lines\"
''K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
'myfile = "CO09700 " & fn4 & ".xlsx"
' Dim strFileName As String
'Dim strFileExists As String
'
'    strFileName = filepath & myfile
'    strFileExists = Dir(strFileName)

   If strFileExists = "" Then
           MsgBox "The current month 97 CO SAR file does not exist"
           
    Else
    
    ActiveSheet.ShowAllData
    ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:= _
        "=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a3").Value, 2) & ".xlsx"
        
   ActiveSheet.Range("$A$1:$AF$60000").AutoFilter Field:=16, Criteria1:=Array _
   ("" & ThisWorkbook.Worksheets("Variables").Range("a6").Value & "")
        
        Range("ac2:ac60000").SpecialCells(xlCellTypeVisible).Formula = "X"
End If

    
    ActiveSheet.ShowAllData
'    ActiveCell.FormulaR1C1 = _
'        "=+IF(AND(RC[-7]=""CO21army" & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & _
'        Right(ThisWorkbook.Worksheets("Variables").Range("A3").Value, 2) & ".xlsx"",OR(RC[-12]=""" _
'        & Right(ThisWorkbook.Worksheets("Variables").Range("a6").Value, 2) & "/" & Left(ThisWorkbook.Worksheets("Variables").Range("a6").Value, 4) & ", RC[-12]=" & Right(ThisWorkbook.Worksheets("Variables").Range("a6").Value, 1) & "/" & Left(ThisWorkbook.Worksheets("Variables").Range("a6").Value, 4) & ",""X"","" "")"
'    Range("AB2").Select
'    Selection.AutoFill Destination:=Range("AB2:AB50172")
'    Range("AB2:AB20172").Select
'    Range("AC2").Select
'    ActiveCell.FormulaR1C1 = _
'        "=+IF(AND(RC[-8]=""=CO09700 " & Left(ThisWorkbook.Worksheets("Variables").Range("a2").Value, 3) & Right(ThisWorkbook.Worksheets("Variables").Range("a3").Value, 2) & ".xlsx"",OR(RC[-13]=""" _
'        & Right(ThisWorkbook.Worksheets("Variables").Range("a6").Value, 2) & "/" & Left(ThisWorkbook.Worksheets("Variables").Range("a6").Value, 4) & ", RC[-13]=" & Right(ThisWorkbook.Worksheets("Variables").Range("a6").Value, 1) & "/" & Left(ThisWorkbook.Worksheets("Variables").Range("a6").Value, 4) & ",""X"","" "")"
'    Range("AC2").Select
'    Selection.AutoFill Destination:=Range("AC2:AC59364")
'    Range("AC2:AC39364").Select
    Range("AD2").Select
    ActiveCell.FormulaR1C1 = "=+IF(OR(ISNA(RC[-4]),ISNA(RC[-3])),""X"","" "")"
    Range("AD2").Select
    Selection.AutoFill Destination:=Range("AD2:AD59364")
    Range("AD2:AD39364").Select
    Range("AE2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlUp)).Select
    
    Range("AE2").Select
    ActiveCell.FormulaR1C1 = "=+IF(OR(RC[-10]=""CO IPAC.xlsx"", RC[-10]=""" & ThisWorkbook.Worksheets("Variables").Range("A2").Value & " CO IPAC " & "(DSSN 3801)" & ".xlsx""), ""X"",  "" "")"
    Range("AE2").Select
    Selection.AutoFill Destination:=Range("AE2:AE59364")
    Range("AE2").Select
    Range("AE2:AE59364").Select
    Range("AF2").Select
    ActiveCell.FormulaR1C1 = "=+CONCATENATE(RC[-4],RC[-3],RC[-2],RC[-1])"
    Range("AF2").Select
    Selection.AutoFill Destination:=Range("AF2:AF59364")
    Range("AF2:AF59364").Select
    Range("AF3").Select
    Range(Selection, Selection.End(xlDown)).Select
   
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("$A$1:$AF$65171").AutoFilter Field:=32, Criteria1:="=X"

    Worksheets.Add().Name = "CO SAR2"
    Range("C18").Select
    Sheets("CO SAR").Select
    Cells.Select
    Range("W1").Activate
    Selection.Copy
    Sheets("CO SAR2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D13").Select
    Range(Selection, Selection.End(xlDown)).Select
    
    Cells.Select
    Selection.ColumnWidth = 8.22
    Cells.EntireColumn.AutoFit
    Sheets("CO SAR").Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Sheets("CO SAR2").Select
    Sheets("CO SAR2").Name = "CO SAR2"
    Sheets("CO SAR2").Select
    Sheets("CO SAR2").Name = "CO SAR"
    Range("D13").Select
    End With
'    Application.Calculation = xlAutomatic
    Application.DisplayAlerts = True
End Sub
 
to show you how to do filtering with vba put this in column A and copy down:
Excel Formula:
=ROW()
put this in column B and copy down:
Excel Formula:
=MOD(ROW(),4)
This should generate some data with row numbers in column A and 0,1,2 or 3 in column B. put the number 0,1,2 or 3 in Cells D1, then run this code ;
VBA Code:
Sub test()
target = Range("D1:D1")
inarr = Range("A1:B28")
outputstr = "Rows with target value="
For i = 1 To UBound(inarr, 1)
  If inarr(i, 2) = target Then
    outputstr = outputstr & inarr(i, 1) & ","
  End If
Next i
MsgBox outputstr
End Sub
this web page about variant arrays might help a bit:
Arrays And Ranges In VBA
awesome thanks!
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Hi, I will attach here with similar question about autofilter:
what could make autofilter on ~3k rows with manual calculation taking ~10 seconds?
I have removed all conditional formatting
Filtering on data copied to another workbook (values with source formatting) is immediate
 
Upvote 0
Hi, I will attach here with similar question about autofilter:
what could make autofilter on ~3k rows with manual calculation taking ~10 seconds?
I have removed all conditional formatting
Filtering on data copied to another workbook (values with source formatting) is immediate
my issue was vlookup. I changed the vlookup to a match function and it ran much faster. You could also try index match.

Jordan
 
Upvote 0
Hmm, but VLOOKUP is not volatile, is it? It should not be recalculated on row visibility change. Plus there is manual calculation…
 
Upvote 0
Hmm, but VLOOKUP is not volatile, is it? It should not be recalculated on row visibility change. Plus there is manual calculation…
im not sure but thats where the code was hanging up everytime so I changed it to match and it was much faster. You can also try the index match function. if you have vlookup i strongly suggest you try that
 
Upvote 0
As a test I have replaced all VLOOKUP/INDEX formulas with their values. Sheet calculation now takes <1s but filtering is still 10s+ :(
Number of records found in the status bar is shown immediately but then 10s of waiting
Could other worksheets be influences by autofilter on this sheet?
Any ideas?
 
Upvote 0
I have replaced ALL formulas with their values in this worksheet and it is still 10s+ to autofilter...
 
Upvote 0
Ok - I now know what excel is actually doing - it is applying conditional formatting on non-active sheets. Conditional formatting is volatile. Sorry for so many posts.
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,040
Members
448,543
Latest member
MartinLarkin

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
Back
Top