Excel Scroll to dated column

[Simont485]

HI all

I use excel for a staff rota.

The dates are from D4 across to FF4 or whatever D4 plus 365 is......but it is a long way to scroll across!
Columns AB&C are for names, information etc....these don't scroll as they are frozen(freeze panes)

I was wondering this:

I would like to enter a date, in say Cell A1, and the spreadsheet scrolls across to that date and be next to column C?

Hope that makes sense!!!​

 

[JustynaMK]

Hi Simon,

Assuming that you're going to enter a date in cell A1 and you are looking at Sheet1, then simply go to your VBA window (Alt+F11), double-click on Sheet1 and enter the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngMatch            As Long


    If Not Intersect(Target, Range("$A$1")) Is Nothing Then
    Application.EnableEvents = True
        On Error Resume Next
        lngMatch = Application.Match(Range("$A$1"), Rows(4), 0)
        If IsNumeric(lngMatch) Then
            ActiveWindow.ScrollColumn = Cells(4, lngMatch).Column
        End If
    End If
    
End Sub

The "Change" Event should automatically scroll your active window to a given column.
Let me know if that helps.

 

[Simont485]

Thank you but I cant get this to work.

I have made a test spreadsheet with dates fromD1:KY1 (1/04/2018 : 02/02/2019)

Columns ABC are frozen panes.

I enter a date in A1 but nothing happens......

Sorry in advance as Ive no understanding of VBA

 

[JustynaMK]

Hi Simon,

No worries! I have assumed that your dates are in row 4, so - as per your previous post - starting from cell D4.
Give it a try and let me know if this is any better.

 

[Simont485]

Yes sorry my mistake!

Woks perfectly! Many Thanks!

 

[JustynaMK]

No problem at all! I'm glad that it works for you take care.

 

[Simont485]

Is it possible to adapt this so that if cell A1 is blank the rota defaults back to D4, which is 1/04/2018 on the rota?

 

[JustynaMK]

Hi Simon,

Yes, try using the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngMatch            As Long


    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
            lngMatch = Application.Match(Range("$A$1"), Rows(4), 0)
        On Error GoTo 0
        If lngMatch > 0 Then
            ActiveWindow.ScrollColumn = Cells(4, lngMatch).Column
        Else
            ActiveWindow.ScrollColumn = Cells(4, 4).Column
        End If
    End If
End Sub

Remember that this is a Change Event, so you would need to go to cell A1 and press Delete key (i.e. "change" cell's A1 value) in order to trigger this event.

 

[Simont485]

That's great many thanks!!

 

[Simont485]

So I have introduced this at work and have had a suggestion that may be useful......

If possible ......when cell A1 is blank it goes to todays date?