Sort By Date THEN auto-scroll to current date

[jmpatrick]

I have a macro that sorts my data based on dates in Column B. As you can see, after the sort completes the cursor parks itself at Cell A1. What I'd like is for it to auto-scroll down to the current date (or closest date) in Column B. Here's my current code:

Sub SortByDate()
Application.ScreenUpdating = False
    ActiveWindow.SmallScroll Down:=-189
    Rows("5:2000").Select
    ActiveWindow.ScrollRow = 1426
    ActiveWindow.ScrollRow = 4
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range( _
        "B5:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range( _
        "D5:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Calendar").Sort.SortFields.Add Key:=Range( _
        "C5:C2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Calendar").Sort
        .SetRange Range("A5:BQ2000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

I suspect the

Range("A1").Select

...needs some sort of =TODAY() code. Am I close?

Any suggestions would be appreciated.

 

[shg]

Sub SortByDate()
  Dim iRow          As Long

  Worksheets("Calendar").Select
  Range("A5", Cells(Rows.Count, "BQ")).Sort Key1:=Range("B5"), _
                                            Key2:=Range("D5"), _
                                            Key3:=Range("C5"), _
                                            Header:=xlYes
  iRow = Evaluate("match(today(), " & Columns(2).Address & ")")
  Application.Goto Cells(iRow, "B")
End Sub

 

[shg]

Change the last line to

Application.Goto Cells(iRow, "B"), Scroll:=True

... if you want to scroll the window to that cell.

 

[jmpatrick]

Thanks shg! Once again, I've learned something new. I'm happy to see the today() in there. Some of this is sinking in!

Another question: your VBA scrolls the current date to the top of the page. What if I wanted the current date to be more of less in the middle of the window? Would I need to add a "-1" component of some sort? Would the "-1" refer to Rows or Days?

 

[jmpatrick]

I'm on to something! I was able to change the last row to this:

Application.Goto Cells(iRow - 1, "B"), Scroll:=True

...which now backs up to the Row prior to the current date. That's better, but I really would like it to auto-scroll to the current date AND have it parked more-or-less in the center of the window (top to bottom).

 

[shg]

What happens if you change -1 to -2? To -3?

 

[jmpatrick]

What happens if you change -1 to -2? To -3?

That seems to work BUT I also have a Conditional Format set up that automatically highlights the currently selected Row. If I put (for instance) -10 I can get today's date to more or less appear in the center of the window, but the highlighted row is the -10 row. Make sense? Here's the Conditional Formatting I'm using:

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Target.Calculate
    End Sub

and

=OR(CELL("row")=CELL("row",C5))

 

[shg]

I don't see any purpose to the selectionchange event.

You have this CF applied to the entire range?? Why not instead

  Application.Goto Cells(iRow - 10, "B")
  Rows(iRow).Select

 

[jmpatrick]

That works beautifully! Such a simple change. Thanks.

 

[shg]

You're welcome.