Enhancing Sort of Times To Distinuguish Between Before and After Times

[Ark68]

I am at a point in my project that has me stumped again.

Consider this worksheet

Excel 2010
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
10	Record ID	Dispatch	Rental	Location	Activity			Groom	Prepare	Signature	Lights On	Lights Off	1	2	3	4	Close
11
12
13	42884043	>1:45P	78791			5:15P	8:15P	CWP	WPL	WPL							WPL	DR	>	1:45:00 PM
14	42884041		77909			6:00P	8:00P	CWP	WPL	WPL							WPL	DR	>	1:45:00 PM
15	42884046	<2:00P	78402			3:00P	4:30P	CWP	CUE	CUE							CUE	DR	<	2:00:00 PM
16	42884001	<2:30P	77896			5:15P	8:15P	CWP	HPL	HPL							HPL	DR	<	2:30:00 PM
17	42884010		77911			5:15P	8:15P	CWP	HPL	HPL							HPL	DR	<	2:30:00 PM
18	42884014		77926			5:15P	8:15P	CWP	CUL	CUL							CUL	DR	<	2:30:00 PM
19	42884002		77933			5:45P	8:45P	CWP	WPL	WPL								DR	<	2:30:00 PM
20	42884003		77933			5:45P	8:45P	CWP	WPL	WPL								DR	<	2:30:00 PM
21	42884007		77876			6:00P	8:15P	CWP	HPL	HPL	NR	NR						DR	<	2:30:00 PM
22	42884009		77872			8:30P	10:30P	CWP	HPL	HPL	HPL	CUL					CUL	DR	<	2:30:00 PM
23	42884039	>2:45P	78070			6:15P	11:00P	CWP	CUL	CUL	CUL	CUL					CUL	DR	>	2:45:00 PM
24
CWP

Right now, the data is sorted based on ascending order of times in column T. This is producing the proper results, but, not when you include the qualifiers in column S. What I need to do is put any > (after) times following any < (before) times. This database serves as a list of activities that need to be done in a chronological order. A final product would look like this:

Excel 2010
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
10	Record ID	Dispatch	Rental	Location	Activity			Groom	Prepare	Signature	Lights On	Lights Off	1	2	3	4	Close
11
12
13	42884046	<2:00P	78402			3:00P	4:30P	CWP	CUE	CUE							CUE	DR	<	2:00:00 PM
14	42884001	<2:30P	77896			5:15P	8:15P	CWP	HPL	HPL							HPL	DR	<	2:30:00 PM
15	42884010		77911			5:15P	8:15P	CWP	HPL	HPL							HPL	DR	<	2:30:00 PM
16	42884014		77926			5:15P	8:15P	CWP	CUL	CUL							CUL	DR	<	2:30:00 PM
17	42884002		77933			5:45P	8:45P	CWP	WPL	WPL								DR	<	2:30:00 PM
18	42884003		77933			5:45P	8:45P	CWP	WPL	WPL								DR	<	2:30:00 PM
19	42884007		77876			6:00P	8:15P	CWP	HPL	HPL	NR	NR						DR	<	2:30:00 PM
20	42884009		77872			8:30P	10:30P	CWP	HPL	HPL	HPL	CUL					CUL	DR	<	2:30:00 PM
21	42884043	>1:45P	78791			5:15P	8:15P	CWP	WPL	WPL							WPL	DR	>	1:45:00 PM
22	42884041		77909			6:00P	8:00P	CWP	WPL	WPL							WPL	DR	>	1:45:00 PM
23	42884039	>2:45P	78070			6:15P	11:00P	CWP	CUL	CUL	CUL	CUL					CUL	DR	>	2:45:00 PM
24
CWP

Here is the code that I am using currently to sort this range:

                    Dim lRowst As Long
                    Dim lRowed As Long
                    Dim vg As String
                    Dim cntdr As Long
                    Dim pp, bm As Long
                    Dim po As Long
                    Dim kl2 As String
                    Dim oRangeSort As Range
                
                    arr2 = Array("DT", "DTS", "DR", "FR", "FT", "CR", "CT", "GS") 'sort order
                    llastrow = .Range("R" & Rows.count).End(xlUp).row
                    Set rdata = .Range("R13:R" & llastrow)
    
                    For po = 0 To UBound(arr2)
                        vg = arr2(po) 'sort value
    
                        cntdr = Application.CountIf(rdata, vg) 'count of sort value
    
                        If cntdr > 0 Then 'there is no vg rows
            
                            On Error Resume Next
                            lRowst = Application.Match(vg, rdata, 0)
                            On Error GoTo 0
            
                            lRowst = lRowst + 12            'start of sort value range
                            lRowed = lRowst + cntdr - 1     'end of sort value range
                
                          'determine sort times
                            For pp = lRowst To lRowed
                                'tournament services
                                If .Range("R" & pp) = "DTS" Then
                                    kl2 = InStr(.Range("B" & pp).Value, "-") - 1
                                    .Range("T" & pp).Value = TimeValue(Mid(.Range("B" & pp).Value, 8, InStr(.Range("B" & pp).Value, "-") - 1 - 7))
                                Else 'regualr diamond
                                    bm = Len(.Range("B" & pp)) - 1 'length of dispatch value
                                    If bm > 0 Then 'setup
                                        If bm > 12 Then
                                            .Range("T" & pp).Value = TimeValue(Right(.Range("B" & pp).Value, bm - 8))
                                        Else
                                            .Range("S" & pp).Value = Left(.Range("B" & pp).Value, 1)
                                            .Range("T" & pp).Value = TimeValue(Right(.Range("B" & pp).Value, bm))
                                        End If
                                    Else 'close
                                        If vg = "DR" Then
                                            bm = Len(.Range("Q" & pp))
                                            '.Range("S" & pp).Value = Left(.Range("Q" & pp).Value, 1)
                                            .Range("T" & pp).Value = TimeValue(Right(.Range("Q" & pp).Value, bm))
                                        End If
                                    End If
                                End If
                            Next pp
                    
                            Set oRangeSort = .Range("A" & lRowst & ":T" & lRowed)
                            oRangeSort.Sort key1:=Range("T" & lRowst), order1:=xlAscending, key2:=Range("R" & lRowst), order2:=xlDescending, Header:=xlNo, _
                                OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
                                Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
                        Else
                            'MsgBox vg & "No"
                        End If
                    Next po
                End If

I hope I've provided enough information and clear enough explanation of what I wish to accomplish. I urge anyone that wishes to provide some direction to ask for clarification if needed in an effort to help me.

I appreciate everyone's contribution.

 

[palaeontology]

Hi, I don't know how to write VBA (though I can read it), so I normally solve many of my excel problems with formulae, or macros.

Are you prepared to add a basic formula into V13 and copy down ... =IF(T13="<",1,2)

Then add a Command Button, that you press any time you want the data re-sorted using the following macro code ... (simply extend the ranges in the code if you have more rows to play with).

Sub sort_times()
'
' sort_times Macro
'


'
    Range("B13:V23").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("V13:V23") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("U13:U23") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B13:V23")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[Ark68]

Hi Palaeontolgy ...

I see where you are going with this and the concept should do what I need to do. I just needed someone with fresh thinking to see a relatively simple solution.
I think I'll be able to adapt my code to integrate your suggestion.

Thank you!