Small updates to VBA Macro code

[krazyness]

Hi all - i hired someone years ago and they created the below code. Now with COVID i need a small change and cannot locate said person that created this for me.

Column A in the data now has a time in it. I need that time to be cleaned like he did with Column AB. Column A always shows date and time like this:

7/31/2020 13:00:00

I would like to sort by that time first before the other sorts also.

Then have the remaining "time" data printed just like AB's remaining is after being split... but in column A.

I hope that makes sense. and anyone can help as everything i've tried can never get it done correctly.

Sub Macro1()
Dim LastRow As Long, r As Long
Dim myInput
myInput = InputBox("Enter Docket Date", "Enter Docket Date")
ActiveWorkbook.Worksheets("Jan 12 docket").PageSetup.LeftHeader = "&""Arial,Bold""&28 DOCKET: " & myInput
ActiveWorkbook.Worksheets("Jan 12 docket").PageSetup.RightHeader = "&P"
Sheets(Sheet1.Name).Activate
LastRow = Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
Range("AB2:AB" & LastRow) = Evaluate("=Index(Mid(" & Range("AB2:AB" & LastRow).Address & ", " & "find("":""," & Range("AB2:AB" & LastRow).Address & ") + 2,find("",""," & Range("AB2:AB" & LastRow).Address & ")-find("":""," & Range("AB2:AB" & LastRow).Address & ") -2),)")
'Sort all of the data
ActiveWorkbook.Worksheets("Jan 12 docket").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Jan 12 docket").Sort.SortFields.Add Key:=Range( _
    "AB2:AB" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="Answer Hearing,Aid of Execution,Order Back,Citation,Bond Appearance", DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("Jan 12 docket").Sort.SortFields.Add Key:=Range( _
    "D2:D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="Answer Hearing,Aid of Execution,Order Back,Citation,Bond Appearance", DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("Jan 12 docket").Sort.SortFields.Add Key:=Range( _
    "U2:U" & LastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Jan 12 docket").Sort
    .SetRange Range("A1:AB" & LastRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'Delete columns that are not needed
Columns("A:C").Delete Shift:=xlToLeft
Columns("B:Q").Delete Shift:=xlToLeft
Columns("D:H").Delete Shift:=xlToLeft
'Add Notes column
Range("D1") = "Notes"
'Arrange columns correctly
Columns("B:B").Cut
Columns("A:A").Insert
Application.CutCopyMode = False
'Split case_style_comp into two lines
r = 2
Do
    Rows(r + 1).Insert
   
    'Split case sides if "vs." is found
    If InStr(1, Cells(r, 3), "vs.") > 0 Then
        Cells(r + 1, 3) = Trim(Right(Cells(r, 3), Len(Cells(r, 3)) - InStr(1, Cells(r, 3), "vs.") - 4))
        Cells(r, 3) = Trim(Left(Cells(r, 3), InStr(1, Cells(r, 3), "vs.") + 3))
    End If
   
    Cells(r + 1, 2) = Cells(r, 4)
   
    Range("A" & r).Resize(2, 4).BorderAround ColorIndex:=1, Weight:=xlThin
    Range("A" & r).Resize(2, 3).BorderAround ColorIndex:=1, Weight:=xlThin
    r = r + 2
Loop While Cells(r, 1) <> ""
'Clear notes
Range("D2:D" & r).ClearContents
'fontsize
Columns("A:D").Font.Size = 14
'orientation
ActiveSheet.PageSetup.Orientation = xlLandscape
'fit all columns
With Worksheets("Jan 12 docket").PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
'Autofit columns
Columns("A:C").AutoFit
Columns("D").ColumnWidth = 60
End Sub

 

[Caleeco]

that works PERFECT!!!!!!!!!!!!!!!!!!!

you are amazing. thank you! hopefully that was a nice little challenge for you.

i can offer nothing more than my thank you.

Awesome, thanks for letting me know!

No worries, happy to help