Question

I have a table with 3 groups (defined by values ‘1G, 3G or 5G’ in column B) as shown below.

For every time (column A) of value 1G, I need to test if a value 3G appears within 10 minutes (shown in column A) of 1G. If so, then I need to test if a value 5G appears within 20 minutes (of time for value 1G).

So read time ‘1G’ then read time ‘3G’ and if =< 10 minutes, then read time ‘5G’ =< 20 minutes.

'Time'    'Group Name'  'Data'
----------
12:08 am       1G        747
12:45 am       1G        745
1:00 am        1G        746
12:36 am       3G        743
12:45 am       3G        747
1:03 am        3G        74
12:50 am       5G        75
1:00 am        5G        741

Format ‘Time’: 9/25/2012 8:37:00 pm

I’m looking to write the result on a new sheet with all data per row.

I have looked at answers on this site and others, but not found answers.
Thank you for your help.

Answer 1

This macro will extract all 1G line that have a 3G within 10 minutes, and a 5G within 20.

   Sub Macro2()
Dim lLastRow As Long, shtOrg As Worksheet, shtDest As Worksheet, rgLoop As Range

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set shtOrg = ActiveSheet
Set shtDest = Sheets.Add

lLastRow = shtOrg.Cells(Rows.Count, 1).End(xlUp).Row

shtOrg.Range("D2:D" & lLastRow).FormulaR1C1 = _
        "=IF(RC[-2]=""1G"",IF(COUNTIFS(C[-3],"">="" &RC[-3],C[-3],""<=""&RC[-3]+10/1440,C[-2],""3G"")*COUNTIFS(C[-3],"">="" &RC[-3],C[-3],""<=""&RC[-3]+20/1440,C[-2],""5G"")>0,TRUE,""""),"""")"
shtOrg.Range("E2:E" & lLastRow).FormulaR1C1 = _
        "=N(IF(RC[-3]=""3G"",COUNTIFS(C[-1],TRUE,C[-4],""<=""&RC[-4],C[-4],"">=""&RC[-4]-10/1440),IF(RC[-3]=""5G"",COUNTIFS(C[-1],TRUE,C[-4],""<=""&RC[-4],C[-4],"">=""&RC[-4]-20/1440),"""")))>0"

shtOrg.Range("A1:E" & lLastRow).AutoFilter field:=4, Criteria1:="TRUE"

shtOrg.Range("A1:C" & lLastRow).SpecialCells(xlCellTypeVisible).Copy shtDest.Cells(1, 1)

shtOrg.Range("A1:E" & lLastRow).AutoFilter
shtOrg.Range("A1:E" & lLastRow).AutoFilter field:=5, Criteria1:="TRUE"
shtOrg.Range("A2:C" & lLastRow).SpecialCells(xlCellTypeVisible).Copy shtDest.Cells(Rows.Count, 1).End(xlUp).Offset(1)

shtOrg.Columns("D:E").ClearContents
shtOrg.Range("A1:E" & lLastRow).AutoFilter


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With


End Sub