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

N

navydog

New Member
Joined
Jul 22, 2023
Messages
11
Office Version
  1. 365
Platform
  1. Windows
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!!


1690044538427.png
 
Sort by date Sort by votes
Peter_SSs said:
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time. 😊



Glad you figured out that the problem with that last shift was that the start time was later than the finish time & therefore needed a modified approach. :)

However, I have some doubts about your posted code. To be sure though, and make any constructive comments, I would need to see some revised sample data and revised requirement since the layout and conditions to transfer to another sheet appear to have changed.



For us to understand, could you please provide some sample data and the expected results from that sample data (with XL2BB as requested earlier) and explain again in relation to that sample/results?
Click to expand...
What I'm trying to do is to do is for each new sheet (AM, PM, and RON), I'm trying to get a count of all rows in the sheet, then get a count of those rows with a 'Yes' value in the 'Svc' column (Column I) and then divide that count by the full row count to get a percentage...Then to filter on LPrio column (Column L) to return only 'Critical' values, get a count of all rows with 'Critical' value and then further filter again on 'Svc' column (Column I) to return rows with 'yes' value and then get a count of those rows and then divide Critical yes count by Critical all count to get criticals percentage. In this data set, I am expecting all rows count 199 and all yes columns count to be 196 and percentage of 196/199=98.49% and then all critical rows count being 91 and Criticals yes row count being 90 and percentage being 90/91 = 98.9%
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Thanks for the clarifications.

All those values that you want can be achieved with formulas without any need to be physically filtering the data. Is that okay? See below for formulas with your sample data (that would all go to the AM sheet)

Where do you want the results?

In fact, do you want all those results or are you really only interested in those percentage values (which could be evaluated directly without counting the various rows first)?

navydog_1.xlsm
OP
1Rows199
2Yes196
3% Yes98.49%
4Critical92
5Yes Critical91
6% Critical Yes98.91%
AM
Cell Formulas
RangeFormula
P1P1=COUNT(E2:E1000)
P2P2=COUNTIF(I2:I1000,"yes")
P3,P6P3=P2/P1
P4P4=COUNTIF(L2:L1000,"Critical")
P5P5=COUNTIFS(L2:L1000,"Critical",I2:I1000,"Yes")
 
Upvote 0
Peter_SSs said:
Thanks for the clarifications.

All those values that you want can be achieved with formulas without any need to be physically filtering the data. Is that okay? See below for formulas with your sample data (that would all go to the AM sheet)

Where do you want the results?

In fact, do you want all those results or are you really only interested in those percentage values (which could be evaluated directly without counting the various rows first)?

navydog_1.xlsm
OP
1Rows199
2Yes196
3% Yes98.49%
4Critical92
5Yes Critical91
6% Critical Yes98.91%
AM
Cell Formulas
RangeFormula
P1P1=COUNT(E2:E1000)
P2P2=COUNTIF(I2:I1000,"yes")
P3,P6P3=P2/P1
P4P4=COUNTIF(L2:L1000,"Critical")
P5P5=COUNTIFS(L2:L1000,"Critical",I2:I1000,"Yes")
Click to expand...
I would like to be able to see the row counts as well as the percentages. That looks awesome!! If I could just put those formulas either into the first few cells in like column O or even possibly in another new sheet that just has a header for each shift and the formulas/values...that way I wouldn't have to go into each individual sheet to get the values...if that makes sense.
 
Upvote 0
Something like this?

navydog_1.xlsm
ABCDEFGH
1AMPMRON
2Rows199Rows0Rows0
3Yes196Yes0Yes0
4% Yes98.49%% Yes#DIV/0!% Yes#DIV/0!
5Critical92Critical0Critical0
6Yes Critical91Yes Critical0Yes Critical0
7% Critical Yes98.91%% Critical Yes#DIV/0!% Critical Yes#DIV/0!
Counts & %
Cell Formulas
RangeFormula
B2B2=COUNT(AM!E2:E1000)
B3B3=COUNTIF(AM!I2:I1000,"yes")
B4,B7,H4,H7,E4,E7B4=B3/B2
B5B5=COUNTIF(AM!L2:L1000,"Critical")
B6B6=COUNTIFS(AM!L2:L1000,"Critical",AM!I2:I1000,"Yes")
E2E2=COUNT(PM!E2:E1000)
E3E3=COUNTIF(PM!I2:I1000,"yes")
E5E5=COUNTIF(PM!L2:L1000,"Critical")
E6E6=COUNTIFS(PM!L2:L1000,"Critical",PM!M2:M1000,"Yes")
H2H2=COUNT(RON!E2:E1000)
H3H3=COUNTIF(RON!I2:I1000,"yes")
H5H5=COUNTIF(RON!L2:L1000,"Critical")
H6H6=COUNTIFS(RON!L2:L1000,"Critical",RON!M2:M1000,"Yes")
 
Upvote 0
Peter_SSs said:
Something like this?

navydog_1.xlsm
ABCDEFGH
1AMPMRON
2Rows199Rows0Rows0
3Yes196Yes0Yes0
4% Yes98.49%% Yes#DIV/0!% Yes#DIV/0!
5Critical92Critical0Critical0
6Yes Critical91Yes Critical0Yes Critical0
7% Critical Yes98.91%% Critical Yes#DIV/0!% Critical Yes#DIV/0!
Counts & %
Cell Formulas
RangeFormula
B2B2=COUNT(AM!E2:E1000)
B3B3=COUNTIF(AM!I2:I1000,"yes")
B4,B7,H4,H7,E4,E7B4=B3/B2
B5B5=COUNTIF(AM!L2:L1000,"Critical")
B6B6=COUNTIFS(AM!L2:L1000,"Critical",AM!I2:I1000,"Yes")
E2E2=COUNT(PM!E2:E1000)
E3E3=COUNTIF(PM!I2:I1000,"yes")
E5E5=COUNTIF(PM!L2:L1000,"Critical")
E6E6=COUNTIFS(PM!L2:L1000,"Critical",PM!M2:M1000,"Yes")
H2H2=COUNT(RON!E2:E1000)
H3H3=COUNTIF(RON!I2:I1000,"yes")
H5H5=COUNTIF(RON!L2:L1000,"Critical")
H6H6=COUNTIFS(RON!L2:L1000,"Critical",RON!M2:M1000,"Yes")
Click to expand...
Yes!! That looks amazing!! Can I do that programmatically with VBA or just manually each time?
 
Upvote 0
Try using this in place of your existing similarly named procedure.

VBA Code: 
Public Sub SortingColumnsInRange_v2()
  Dim i As Long
  Dim ShiftNames As Variant
  
  Const FrmlaBases As String = "#=COUNT('^'!E2:E1000)|#=COUNTIF('^'!I2:I1000,""yes"")||#=COUNTIF('^'!L2:L1000,""Critical"")|#=COUNTIFS('^'!L2:L1000,""Critical"",'^'!I2:I1000,""Yes"")|"
  
  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("Rows", "Yes", "% Yes", "Critical", "Yes Critical", "% Critical Yes"))
    .UsedRange.EntireColumn.ColumnWidth = 15
    .Rows(1).HorizontalAlignment = xlRight
    With .Range("B4:D4,B7:D7")
      .NumberFormat = "0.00%"
      .FormulaR1C1 = "=IF(R[-2]C=0,"""",R[-1]C/R[-2]C)"
    End With
  End With
End Sub
 
Upvote 0
Peter_SSs said:
Try using this in place of your existing similarly named procedure.

VBA Code: 
Public Sub SortingColumnsInRange_v2()
  Dim i As Long
  Dim ShiftNames As Variant
 
  Const FrmlaBases As String = "#=COUNT('^'!E2:E1000)|#=COUNTIF('^'!I2:I1000,""yes"")||#=COUNTIF('^'!L2:L1000,""Critical"")|#=COUNTIFS('^'!L2:L1000,""Critical"",'^'!I2:I1000,""Yes"")|"
 
  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("Rows", "Yes", "% Yes", "Critical", "Yes Critical", "% Critical Yes"))
    .UsedRange.EntireColumn.ColumnWidth = 15
    .Rows(1).HorizontalAlignment = xlRight
    With .Range("B4:D4,B7:D7")
      .NumberFormat = "0.00%"
      .FormulaR1C1 = "=IF(R[-2]C=0,"""",R[-1]C/R[-2]C)"
    End With
  End With
End Sub
Click to expand...
Peter, thank you SO MUCH for your help!! This is working perfectly!!! Now, my absolute last question...if I'm wanting to give this template to someone so that they can perform these actions when i'm on vacation (and I'm not so much as turning my work phone on during vacation), is there a way to put all of these modules into a single module so that they can execute the one module instead of three separate actions?
 
Upvote 0
navydog said:
is there a way to put all of these modules into a single module so that they can execute the one module instead of three
Click to expand...
I think that you mean 'procedures' not 'modules' but the answer should be 'yes'. If you need help with that, please post the three current procedures [so that I am sure I have the most recent version(s)] in the order that you want them executed.
 
Upvote 0
Here are the 3 procedures that I execute in order

VBA Code: 
Public Sub TextToCol1()

Dim ws As Worksheet, lRow As Long

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
End Sub



Public Sub SortingColumnsInRange_v2()
  Dim i As Long
  Dim ShiftNames As Variant
  
  Const FrmlaBases As String = "#=COUNT('^'!E2:E1000)|#=COUNTIF('^'!I2:I1000,""yes"")||#=COUNTIF('^'!L2:L1000,""Critical"")|#=COUNTIFS('^'!L2:L1000,""Critical"",'^'!I2:I1000,""Yes"")|"
  
  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
End Sub




Sub Test()
  Dim rCrit As Range
 
  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.ClearContents
  End With

  With Sheets("LAVEXPORT").Range("A1").CurrentRegion
    Set rCrit = .Offset(, .Columns.Count + 1).Resize(2, 1)
    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)))"
    '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>EndT,G2>=StartT,G2<=EndT)))"
    .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Sheets("PM").Range("A1"), Unique:=False
    rCrit.ClearContents
  End With

  With Sheets("LAVEXPORT").Range("A1").CurrentRegion
    Set rCrit = .Offset(, .Columns.Count + 1).Resize(2, 1)
    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
 
Upvote 0
navydog said:
Here are the 3 procedures that I execute in order
Click to expand...
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.

VBA Code: 
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
 
Upvote 1
Solution
You must log in or register to reply here.

Similar threads

I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
184
Peter_SSs
Peter_SSs
K
  • Question Question
[VBA] Applying filter to multiple tables on same sheet
Replies
2
Views
272
kleinmat
K
D
  • Question Question
Generating Reports in Word Using Data in Excel
Replies
1
Views
312
Dan_W
D
G
  • Question Question
Improve calculation speed for this worksheet with INDIRECT/FILTER functions
Replies
0
Views
337
GeneBF
G
R
  • Solved
Excel VBA to filter by unique value, copy paste into new workbook and save
Replies
2
Views
796
rittersportyummy
R

Forum statistics

Threads
1,223,632
Messages
6,173,472
Members
452,516
Latest member
archcalx

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