Center screen on a cell in a named range

[L. Howard]

I'm having trouble with getting my SelectionChange event macro to hold hands with the generic
Sub CenterOnCell(OnCell As Range).

(The first If -- End If is for a drop down column to widen it to better read the entry list and has no bearing on my centering problem.)

The cell to center on for each named range is listed with the dim statement for that range.

If I click anywhere in any of the Dimmed named ranges, I get the correct "Hello ..." message.

The commented out line in the "If Target aMon..." sends Excel into a lock up so I know that needs to be somewhere else to call the centering code.

Can't figure how to get my centering cell "L10" where "S50" is in this line CenterOnCell Range("S50") or where this line should be when it is 'CenterOnCell Range("L10").

Thanks.
Howard

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
  If Target.Column = 25 Then
     Target.Columns.ColumnWidth = 11
   Else
     Columns(25).ColumnWidth = 6.86
End If
   
Dim aMon As Range   'aMon   center on  L10
Dim aTue As Range    'aTue   center on  AI10
Dim aWed As Range   'aWed  center on  L44
Dim aThur As Range  'aThur  center on  AI44
Dim aFri As Range     'aFri     center on  L76
Dim aSat As Range    'aSat    center on  AC76

 On Error Resume Next
 On Error GoTo 0

    If Not Intersect(Target, Range("aMon")) Is Nothing Then
        MsgBox "Hello Monday"
        'CenterOnCell Range("L10")
        
      ElseIf Not Intersect(Target, Range("aTue")) Is Nothing Then
        MsgBox "Hello Tuesday"
        
      ElseIf Not Intersect(Target, Range("aWed")) Is Nothing Then
        MsgBox "Hello Wed"
        
      ElseIf Not Intersect(Target, Range("aThur")) Is Nothing Then
        MsgBox "Hello Thur"
        
      ElseIf Not Intersect(Target, Range("aFri")) Is Nothing Then
        MsgBox "Hello Fri"
        
      ElseIf Not Intersect(Target, Range("aSat")) Is Nothing Then
        MsgBox "Hello Sat"
        
    End If
   
End Sub


Sub CenterOnCell(OnCell As Range)

 Dim VisRows As Integer
 Dim VisCols As Integer

 Application.ScreenUpdating = False
 '
 ' Switch over to the OnCell's workbook and worksheet.
 '
 OnCell.Parent.Parent.Activate
 OnCell.Parent.Activate
 '
 ' Get the number of visible rows and columns for the active window.
 '
 With ActiveWindow.VisibleRange
     VisRows = .Rows.Count
     VisCols = .Columns.Count
 End With
 '
 ' Now, determine what cell we need to GOTO. The GOTO method will
 ' place that cell reference in the upper left corner of the screen,
 ' so that reference needs to be VisRows/2 above and VisCols/2 columns
 ' to the left of the cell we want to center on. Use the MAX function
 ' to ensure we're not trying to GOTO a cell in row <=0 or column <=0.
 '
 With Application
     .Goto reference:=OnCell.Parent.Cells( _
         .WorksheetFunction.Max(1, OnCell.Row + _
         (OnCell.Rows.Count / 2) - (VisRows / 2)), _
         .WorksheetFunction.Max(1, OnCell.Column + _
         (OnCell.Columns.Count / 2) - _
         .WorksheetFunction.RoundDown((VisCols / 2), 0))), _
      Scroll:=True
 End With

 OnCell.Select
 Application.ScreenUpdating = True

 End Sub

'You can then call this procedure to center the screen on a cell.
'For example to center the screen on S50, use
'CenterOnCell Range("S50")

 

[L. Howard]

Well, this does center on the correct cell then errors out on this line AND the worksheet is frozen. Ctrl + Alt + Delete to escape.

.Goto reference:=OnCell.Parent.Cells( _
.WorksheetFunction.Max(1, OnCell.Row + ....

Any suggestions?

Howard

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
   If Target.Column = 25 Then
       Target.Columns.ColumnWidth = 11
   Else
       Columns(25).ColumnWidth = 6.86
   End If
   
Dim aMon As Range   'aMon   center on  L10
Dim aTue As Range    'aTue   center on  AI10
Dim aWed As Range   'aWed  center on  L44
Dim aThur As Range  'aThur  center on  AI44
Dim aFri As Range     'aFri     center on  L76
Dim aSat As Range    'aSat    center on  AC76
Dim i As String

 On Error Resume Next
 On Error GoTo 0

    If Not Intersect(Target, Range("aMon")) Is Nothing Then
        CenterOnCell Range("L10")
       
      ElseIf Not Intersect(Target, Range("aTue")) Is Nothing Then
        CenterOnCell Range("AI10")
        
      ElseIf Not Intersect(Target, Range("aWed")) Is Nothing Then
         CenterOnCell Range("L44")
         
      ElseIf Not Intersect(Target, Range("aThur")) Is Nothing Then
         CenterOnCell Range("AI44")
         
      ElseIf Not Intersect(Target, Range("aFri")) Is Nothing Then
         CenterOnCell Range("L76")
         
      ElseIf Not Intersect(Target, Range("aSat")) Is Nothing Then
         CenterOnCell Range("AC76")
         
    End If

End Sub


Sub CenterOnCell(OnCell As Range)

 Dim VisRows As Integer
 Dim VisCols As Integer

 Application.ScreenUpdating = False
 '
 ' Switch over to the OnCell's workbook and worksheet.
 On Error Resume Next
 
 OnCell.Parent.Parent.Activate
 OnCell.Parent.Activate
 '
 ' Get the number of visible rows and columns for the active window.
 '
 With ActiveWindow.VisibleRange
     VisRows = .Rows.Count
     VisCols = .Columns.Count
 End With
 With Application
     .Goto reference:=OnCell.Parent.Cells( _
         .WorksheetFunction.Max(1, OnCell.Row + _
         (OnCell.Rows.Count / 2) - (VisRows / 2)), _
         .WorksheetFunction.Max(1, OnCell.Column + _
         (OnCell.Columns.Count / 2) - _
         .WorksheetFunction.RoundDown((VisCols / 2), 0))), _
      Scroll:=True
 End With

 OnCell.Select
 Application.ScreenUpdating = True

 End Sub