Excel Macro how do I filter time using VBA to copy/paste to different sheet

[navydog]

I'm trying to use VBA to automate a process I perform multiple times a day. I've figured out a little bit but I've got 2 different columns containing time. The estimated time is sometimes populated so I want to be able to filter on 2 conditions: either ET (Estimated Time) is populated and contains a time in a range (between 06:30 and 14:30) and if empty, then Scheduled Time falls between 06:30 and 14:30. Once that filtering is done, then copy/paste those resulting rows into a different sheet. I know almost nothing about VBA and need help...PLEASE!!

 

[navydog]

Thanks. It is pretty much just a matter of putting all the internal code from the 3 procedures into one single procedure. It can be a matter of personal preference but I like to have all the 'Dim' and 'Const' statements at the start of the procedure so I have moved them to that position.
There was also a certain amount of unnecessary repetition, especially in that last procedure (eg no need to keep setting the same data range, no need to keep setting rCrit and no need to clear rCrit until all filters have been processed) so I have streamlined that a bit.

I have not tested the resultant procedure so please do so with a copy of your workbook.

Public Sub All_3_Procedures()
  Dim ws As Worksheet, lRow As Long
  Dim i As Long
  Dim ShiftNames As Variant
  Dim rCrit As Range
 
  Const FrmlaBases As String = "#=COUNT('^'!E2:E1000)|#=COUNTIF('^'!I2:I1000,""yes"")||#=COUNTIF('^'!L2:L1000,""Critical"")|#=COUNTIFS('^'!L2:L1000,""Critical"",'^'!I2:I1000,""Yes"")|"

'***** TextToCol1 *****
  Set ws = ActiveWorkbook.Worksheets("LAVEXPORT")
 
  ws.Range("B2:C3000").ClearContents
 
    With ws
      lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
      .Range("A1:A" & lRow).TextToColumns Semicolon:=True
      .Range("A1:N3000").AutoFilter
      .Range("A1:N3000").VerticalAlignment = xlCenter
      .Range("A1:N3000").HorizontalAlignment = xlCenter
      .Range("A1:N3000").Columns.AutoFit
         
  End With

'***** SortingColumnsInRange *****
  ShiftNames = Split("AM PM RON")

  Range("A:N").Sort key1:=Columns("E"), Order1:=xlAscending, Key2:=Columns("F"), Order2:=xlAscending, Header:=xlYes
 
  Sheets.Add(After:=Sheets("LAVEXPORT")).Name = "Counts"

  For i = 0 To UBound(ShiftNames)
    Sheets.Add(Before:=Sheets("Counts")).Name = ShiftNames(i)
    With Sheets("Counts")
      .Cells(1, i + 2).Value = ShiftNames(i)
      With .Cells(2, i + 2).Resize(6)
        .Value = Application.Transpose(Split(Replace(FrmlaBases, "^", ShiftNames(i)), "|"))
        .Replace What:="#", Replacement:="", LookAt:=xlPart
      End With
    End With
  Next i
 
  With Sheets("Counts")
    .Range("A2:A7").Value = Application.Transpose(Array("Overall Flights Count", "Overall Flights Completed", "Overall Completion Rate (%)", "Critical Flights Count", "Critical Flights Completed", "Critical Completion Rate (%)"))
    .UsedRange.EntireColumn.ColumnWidth = 15
    .Rows(1).HorizontalAlignment = xlCenter
    With .Range("B4:D4,B7:D7")
      .NumberFormat = "0.0%"
      .FormulaR1C1 = "=IF(R[-2]C=0,"""",R[-1]C/R[-2]C)"
    End With
  End With

'***** Test *****
  With Sheets("LAVEXPORT").Range("A1").CurrentRegion
    Set rCrit = .Offset(, .Columns.Count + 1).Resize(2, 1)
   
    rCrit.Cells(2).Formula = "=LET(StartT,TIME(6,30,0),EndT,TIME(15,00,0),OR(AND(F2>=StartT,G2<=EndT,F2>=StartT,F2<=EndT),AND(G2="""",F2>=StartT,F2<=EndT),AND(F2<=StartT,G2>=StartT,G2<=EndT),AND(F2>EndT,G2>=StartT,G2<=EndT)))"
    .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Sheets("AM").Range("A1"), Unique:=False

    rCrit.Cells(2).Formula = "=LET(StartT,TIME(15,01,0),EndT,TIME(23,00,0),OR(AND(G2>=StartT,G2<=EndT,F2>=StartT,F2<=EndT),AND(G2="""",F2>=StartT,F2<=EndT),AND(F2<=StartT,G2>=StartT,G2<=EndT),AND(F2>EndT,G2>=StartT,G2<=EndT)))"
    .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Sheets("PM").Range("A1"), Unique:=False
 
    rCrit.Cells(2).Formula = "=LET(StartT,TIME(23,01,0),EndT,TIME(23,59,0),StartT2,TIME(00,00,0),EndT2,TIME(06,29,0),OR(AND(F2<=StartT, G2>=StartT, G2<=EndT, G2<>""""), AND(F2>=StartT, F2<=EndT, G2>=StartT, G2<=EndT, G2<>""""),AND(F2>=StartT, F2<=EndT, G2=""""),AND(F2>=StartT2, F2<=EndT2, G2=""""),AND(F2>=EndT2, G2>=StartT2, G2<=EndT2,G2<>""""), AND(F2>=StartT2, F2<=EndT2, G2>=StartT2, G2<=EndT2, G2<>""""), AND(F2>=EndT2, G2>=StartT2, G2<=EndT2, G2<>"""")))"
   .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Sheets("RON").Range("A1"), Unique:=False
  
    rCrit.ClearContents
  End With

End Sub

Mr. Peter, that worked like a freakin charm. You are a scholar and a gentleman! Thank you so much for your help!!!!!!

 

[Peter_SSs]

You are welcome. Thanks for your kind words.