filtering during vba take way to long

J

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
440
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
 
Sort by date Sort by votes
Turn calculation off before doing the filtering after you add those formulas, then turn it back on before you add the IFNA ones later.
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
RoryA said:
Turn calculation off before doing the filtering after you add those formulas, then turn it back on before you add the IFNA ones later.
Click to expand...
that doesnt seem to have helped

Application.Calculation = xlManual
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)"

thats where I started it above


Range("ac2:ac60000").SpecialCells(xlCellTypeVisible).Formula = "X"
End If

Application.Calculation = xlAutomatic
thats where i ended it

Jordan
 
Upvote 0
I'm just going through your code trying to tidy it up, and I'm confused by something. In this part:

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

You select a different specified sheet, filter it, then populate the visible cells in a range on the "CO SARS" sheet. Why? Did you not mean to populate the cells left visible by the filter?

Also, your dng and dng1 variables refer to the same range - is that intentional?
 
Upvote 0
RoryA said:
I'm just going through your code trying to tidy it up, and I'm confused by something. In this part:

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

You select a different specified sheet, filter it, then populate the visible cells in a range on the "CO SARS" sheet. Why? Did you not mean to populate the cells left visible by the filter?

Also, your dng and dng1 variables refer to the same range - is that intentional?
Click to expand...
My apologies I was using a different version for presenting purposes vs a working vs. basically I dont use that code any more. The point of it all is to filter both sheets with both matching master keys and then take the matching data and copy and paste the data into a new sheet and only have the matching data on that sheeet, on the IDARRS sheet that data never gets copied or pasted. Here is the updated code below where I have that part commented out.



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.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
    
 

   If strFileExists2 = "" Then
    
    
    
    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"
        
        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"

    
    
    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.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

    
    If .AutoFilterMode Then
        If .FilterMode Then
            .ShowAllData
        End If
    Else
        If .FilterMode Then
            .ShowAllData
        End If
    End If

'    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.DisplayAlerts = True
End Sub

thanks

Jordan
 
Upvote 0
See if this is any better?

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

'
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    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
    'Dim ThisWorkbook.Worksheets("Variables").Range("A1").Value As String
    Dim fn10 As String
    
    Set ws = Sheets("CO SAR")
    With ws
        Xrow = .Cells(.Rows.Count, "F").End(xlUp).row
        
        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)
    
        .Range("V1:AF1").Value = Array("97 Prior", "97 Current", "21 Prior", "21 Current", "97 Vlookup", "21 Vlookup", "Helper1", "Helper2", "Helper3", "Helper4", "Helper5")
    
    
        Dim VariablesSheet As Worksheet
        Set VariablesSheet = ThisWorkbook.Worksheets("Variables")
        
    'Variablessheet.Range("A1").Value = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
        fn10 = Mid(VariablesSheet.Range("A1").Value, 4, 3)
        
        Dim fn4 As String
        Dim filepath As String
        Dim myfile As String
        
        fn4 = Right(VariablesSheet.Range("A1").Value, 5)
        filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & VariablesSheet.Range("A4").Value & "\" & VariablesSheet.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(Variablessheet.Range("A7").Value & Variablessheet.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
        
            With .Range("$A$1:$U$60000")
               .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("a9").Value, 2) & ".xlsx", Operator:=xlOr, _
                                           Criteria2:="=CO21army" & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
               
               dng12.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+-RC[-2]"
               
            
               .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a2").Value, 2) & ".xlsx", Operator:=xlOr, _
                                           Criteria2:="=CO21army" & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a3").Value, 2) & ".xlsx"
            
                dng12.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+RC[-2]"
               
               .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("a9").Value, 2) & ".xlsx", Operator:=xlOr, _
                                           Criteria2:="=CO21army" & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
               
               dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+-RC[-2]"
               
               .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a2").Value, 2) & ".xlsx", Operator:=xlOr, _
                                           Criteria2:="=CO21army" & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a3").Value, 2) & ".xlsx"
               
               dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+RC[-2]"
            
               .AutoFilter Field:=21
            
            End With
        
            With .Range("$A$1:$AF$60000")
                .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("a9").Value, 2) & ".xlsx"
                
                dng1.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-9],RC[-4])"
            
                .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a3").Value, 2) & ".xlsx"
                
                dng2.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-10],RC[-5])"
            End With
      
       End If
       
      
      
        Dim fn5 As String
        Dim filepath2 As String
        Dim myfile2 As String
      
      
        fn5 = Right(VariablesSheet.Range("A1").Value, 5)
        filepath2 = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & VariablesSheet.Range("A4").Value & "\" & VariablesSheet.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(Variablessheet.Range("A7").Value & " " & Variablessheet.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
       
             With .Range("$A$1:$AF$60000")
                 .AutoFilter Field:=21, Criteria1:="=CO21army" & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
                 
                  dng3.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-11],RC[-6])"
            
                 .AutoFilter Field:=21, Criteria1:="=CO21army" & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
                 
                  dng4.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-12],RC[-7])"
                  
             End With
            
        End If
        
'fn4 = Right(Variablessheet.Range("A1").Value, 5)
'filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & Variablessheet.Range("A4").Value & "\" & Variablessheet.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
        
            .Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("a9").Value, 2) & ".xlsx"
            
            dng5.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+VLOOKUP(RC[-4],C[-3],1,FALSE)"
                
        End If
    
 
        If strFileExists2 = "" Then
        
        Else
        
            With .Range("$A$1:$AF$60000")
                .AutoFilter Field:=21, Criteria1:="CO21army" & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
            
                dng6.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+VLOOKUP(RC[-3],C[-2],1,FALSE)"
             
                .AutoFilter Field:=21, Criteria1:="CO21army" & Left(VariablesSheet.Range("a7").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
                .AutoFilter Field:=16, Criteria1:=Array("" & VariablesSheet.Range("a6").Value & "")
            
                .Range("ab2:ab60000").SpecialCells(xlCellTypeVisible).Formula = "X"
    
            End With
            
        End If
    
    
    '
    'fn4 = Right(Variablessheet.Range("A1").Value, 5)
    'filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & Variablessheet.Range("A4").Value & "\" & Variablessheet.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
        
            .ShowAllData
            With .Range("$A$1:$AF$60000")
            
                .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a3").Value, 2) & ".xlsx"
                .AutoFilter Field:=16, Criteria1:=Array("" & VariablesSheet.Range("a6").Value & "")
            
                .Range("ac2:ac60000").SpecialCells(xlCellTypeVisible).Formula = "X"
                
            End With
        End If
    
        
        If .AutoFilterMode Then
            If .FilterMode Then
                .ShowAllData
            End If
        Else
            If .FilterMode Then
                .ShowAllData
            End If
        End If
    
    '    ActiveCell.FormulaR1C1 = _
    '        "=+IF(AND(RC[-7]=""CO21army" & Left(Variablessheet.Range("a2").Value, 3) & _
    '        Right(Variablessheet.Range("A3").Value, 2) & ".xlsx"",OR(RC[-12]=""" _
    '        & Right(Variablessheet.Range("a6").Value, 2) & "/" & Left(Variablessheet.Range("a6").Value, 4) & ", RC[-12]=" & Right(Variablessheet.Range("a6").Value, 1) & "/" & Left(Variablessheet.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(Variablessheet.Range("a2").Value, 3) & Right(Variablessheet.Range("a3").Value, 2) & ".xlsx"",OR(RC[-13]=""" _
    '        & Right(Variablessheet.Range("a6").Value, 2) & "/" & Left(Variablessheet.Range("a6").Value, 4) & ", RC[-13]=" & Right(Variablessheet.Range("a6").Value, 1) & "/" & Left(Variablessheet.Range("a6").Value, 4) & ",""X"","" "")"
    '    Range("AC2").Select
    '    Selection.AutoFill Destination:=Range("AC2:AC59364")
    '    Range("AC2:AC39364").Select
        .Range("AD2:AD59364").FormulaR1C1 = "=+IF(OR(ISNA(RC[-4]),ISNA(RC[-3])),""X"","" "")"
        .Range("AE2:AE59364").FormulaR1C1 = "=+IF(OR(RC[-10]=""CO IPAC.xlsx"", RC[-10]=""" & VariablesSheet.Range("A2").Value & " CO IPAC " & "(DSSN 3801)" & ".xlsx""), ""X"",  "" "")"
        .Range("AF2:AF59364").FormulaR1C1 = "=+CONCATENATE(RC[-4],RC[-3],RC[-2],RC[-1])"
    
        .Range("$A$1:$AF$65171").AutoFilter Field:=32, Criteria1:="=X"
    End With

    With Worksheets.Add()
        .Name = "CO SAR2"
        ws.UsedRange.Copy
        .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .UsedRange.EntireColumn.AutoFit
        ws.Delete
        .Name = "CO SAR"
    End With
        
    With Application
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
 
Upvote 0
RoryA said:
See if this is any better?

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

'
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    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
    'Dim ThisWorkbook.Worksheets("Variables").Range("A1").Value As String
    Dim fn10 As String
   
    Set ws = Sheets("CO SAR")
    With ws
        Xrow = .Cells(.Rows.Count, "F").End(xlUp).row
       
        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)
   
        .Range("V1:AF1").Value = Array("97 Prior", "97 Current", "21 Prior", "21 Current", "97 Vlookup", "21 Vlookup", "Helper1", "Helper2", "Helper3", "Helper4", "Helper5")
   
   
        Dim VariablesSheet As Worksheet
        Set VariablesSheet = ThisWorkbook.Worksheets("Variables")
       
    'Variablessheet.Range("A1").Value = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
        fn10 = Mid(VariablesSheet.Range("A1").Value, 4, 3)
       
        Dim fn4 As String
        Dim filepath As String
        Dim myfile As String
       
        fn4 = Right(VariablesSheet.Range("A1").Value, 5)
        filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & VariablesSheet.Range("A4").Value & "\" & VariablesSheet.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(Variablessheet.Range("A7").Value & Variablessheet.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
       
            With .Range("$A$1:$U$60000")
               .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("a9").Value, 2) & ".xlsx", Operator:=xlOr, _
                                           Criteria2:="=CO21army" & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
              
               dng12.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+-RC[-2]"
              
           
               .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a2").Value, 2) & ".xlsx", Operator:=xlOr, _
                                           Criteria2:="=CO21army" & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a3").Value, 2) & ".xlsx"
           
                dng12.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+RC[-2]"
              
               .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("a9").Value, 2) & ".xlsx", Operator:=xlOr, _
                                           Criteria2:="=CO21army" & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
              
               dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+-RC[-2]"
              
               .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a2").Value, 2) & ".xlsx", Operator:=xlOr, _
                                           Criteria2:="=CO21army" & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a3").Value, 2) & ".xlsx"
              
               dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+RC[-2]"
           
               .AutoFilter Field:=21
           
            End With
       
            With .Range("$A$1:$AF$60000")
                .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("a9").Value, 2) & ".xlsx"
               
                dng1.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-9],RC[-4])"
           
                .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a3").Value, 2) & ".xlsx"
               
                dng2.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-10],RC[-5])"
            End With
     
       End If
      
     
     
        Dim fn5 As String
        Dim filepath2 As String
        Dim myfile2 As String
     
     
        fn5 = Right(VariablesSheet.Range("A1").Value, 5)
        filepath2 = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & VariablesSheet.Range("A4").Value & "\" & VariablesSheet.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(Variablessheet.Range("A7").Value & " " & Variablessheet.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
      
             With .Range("$A$1:$AF$60000")
                 .AutoFilter Field:=21, Criteria1:="=CO21army" & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
                
                  dng3.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-11],RC[-6])"
           
                 .AutoFilter Field:=21, Criteria1:="=CO21army" & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
                
                  dng4.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+CONCATENATE(RC[-12],RC[-7])"
                 
             End With
           
        End If
       
'fn4 = Right(Variablessheet.Range("A1").Value, 5)
'filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & Variablessheet.Range("A4").Value & "\" & Variablessheet.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
       
            .Range("$A$1:$AF$60000").AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("a9").Value, 2) & ".xlsx"
           
            dng5.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+VLOOKUP(RC[-4],C[-3],1,FALSE)"
               
        End If
   

        If strFileExists2 = "" Then
       
        Else
       
            With .Range("$A$1:$AF$60000")
                .AutoFilter Field:=21, Criteria1:="CO21army" & Left(VariablesSheet.Range("a8").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
           
                dng6.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=+VLOOKUP(RC[-3],C[-2],1,FALSE)"
            
                .AutoFilter Field:=21, Criteria1:="CO21army" & Left(VariablesSheet.Range("a7").Value, 3) & Right(VariablesSheet.Range("A3").Value, 2) & ".xlsx"
                .AutoFilter Field:=16, Criteria1:=Array("" & VariablesSheet.Range("a6").Value & "")
           
                .Range("ab2:ab60000").SpecialCells(xlCellTypeVisible).Formula = "X"
   
            End With
           
        End If
   
   
    '
    'fn4 = Right(Variablessheet.Range("A1").Value, 5)
    'filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\97 Field Details\" & Variablessheet.Range("A4").Value & "\" & Variablessheet.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
       
            .ShowAllData
            With .Range("$A$1:$AF$60000")
           
                .AutoFilter Field:=21, Criteria1:="=CO09700 " & Left(VariablesSheet.Range("a2").Value, 3) & Right(VariablesSheet.Range("a3").Value, 2) & ".xlsx"
                .AutoFilter Field:=16, Criteria1:=Array("" & VariablesSheet.Range("a6").Value & "")
           
                .Range("ac2:ac60000").SpecialCells(xlCellTypeVisible).Formula = "X"
               
            End With
        End If
   
       
        If .AutoFilterMode Then
            If .FilterMode Then
                .ShowAllData
            End If
        Else
            If .FilterMode Then
                .ShowAllData
            End If
        End If
   
    '    ActiveCell.FormulaR1C1 = _
    '        "=+IF(AND(RC[-7]=""CO21army" & Left(Variablessheet.Range("a2").Value, 3) & _
    '        Right(Variablessheet.Range("A3").Value, 2) & ".xlsx"",OR(RC[-12]=""" _
    '        & Right(Variablessheet.Range("a6").Value, 2) & "/" & Left(Variablessheet.Range("a6").Value, 4) & ", RC[-12]=" & Right(Variablessheet.Range("a6").Value, 1) & "/" & Left(Variablessheet.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(Variablessheet.Range("a2").Value, 3) & Right(Variablessheet.Range("a3").Value, 2) & ".xlsx"",OR(RC[-13]=""" _
    '        & Right(Variablessheet.Range("a6").Value, 2) & "/" & Left(Variablessheet.Range("a6").Value, 4) & ", RC[-13]=" & Right(Variablessheet.Range("a6").Value, 1) & "/" & Left(Variablessheet.Range("a6").Value, 4) & ",""X"","" "")"
    '    Range("AC2").Select
    '    Selection.AutoFill Destination:=Range("AC2:AC59364")
    '    Range("AC2:AC39364").Select
        .Range("AD2:AD59364").FormulaR1C1 = "=+IF(OR(ISNA(RC[-4]),ISNA(RC[-3])),""X"","" "")"
        .Range("AE2:AE59364").FormulaR1C1 = "=+IF(OR(RC[-10]=""CO IPAC.xlsx"", RC[-10]=""" & VariablesSheet.Range("A2").Value & " CO IPAC " & "(DSSN 3801)" & ".xlsx""), ""X"",  "" "")"
        .Range("AF2:AF59364").FormulaR1C1 = "=+CONCATENATE(RC[-4],RC[-3],RC[-2],RC[-1])"
   
        .Range("$A$1:$AF$65171").AutoFilter Field:=32, Criteria1:="=X"
    End With

    With Worksheets.Add()
        .Name = "CO SAR2"
        ws.UsedRange.Copy
        .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .UsedRange.EntireColumn.AutoFit
        ws.Delete
        .Name = "CO SAR"
    End With
       
    With Application
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
Click to expand...
thanks Rory! I plugged it in and it runs significantly slower. Im wondering if I should either put a range in the vlookup so its not searching the whole column or just once the vlookup formula is completed copy and paste values over the visible cells, what are your thoughts on this strategyy?
 
Upvote 0
A VLOOKUP on the whole column shouldn't be any worse than on a specific range really. It may be worth pasting over the formulas afterwards - in that case you could skip turning calculation off and back on.
 
Upvote 0
Can I suggest that to really speed this up you take a completely different approach, It appears to me that you are just filtering the same range multiple times just to write different formula into various columns. It would faster if you load the range into a variant array , loaded the columns where you want the formula into more ( output) variant arrays, then do one loop through the range with the filter conditions checked within vba, then finally writethe formula back to the sheet,. I would expect this to take a few seconds.
 
Upvote 0
offthelip said:
Can I suggest that to really speed this up you take a completely different approach, It appears to me that you are just filtering the same range multiple times just to write different formula into various columns. It would faster if you load the range into a variant array , loaded the columns where you want the formula into more ( output) variant arrays, then do one loop through the range with the filter conditions checked within vba, then finally writethe formula back to the sheet,. I would expect this to take a few seconds.
Click to expand...
revisiting this. How would I do that? is there a good read about that? I was thinking about using the dictionary because people seem to think thats a good solution. If all else fails I will change to match index lol.!

Jordan
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Replacing delete with a value
Replies
3
Views
144
Alex Blakenburg
A
B
  • Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
458
Alex Blakenburg
A
R
  • Question
Filter & Delete Deleting Header Row Suddenly
Replies
0
Views
214
reberryjr
R
C
  • Question
VBA: Filter specific data from table then make formula and put result to summary workbook
Replies
1
Views
376
HighAndWilder
H
N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
169
DanteAmor
DanteAmor

Forum statistics

Threads
1,214,641
Messages
6,120,685
Members
448,978
Latest member
rrauni

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