Hi I posted something similar a while back. I found a solution, but it requires me to turn off freeze panes and jump through quite a few hoops. I was wondering if anyone had any thoughts on getting this to work more smoothly

Current Solution:

Private Function ScreenDPI(bVert As Boolean) As Long
   Static lDPI&(1), lDC&


   If lDPI(0) = 0 Then
      lDC = GetDC(0)
      lDPI(0) = GetDeviceCaps(lDC, 88&)               'horz
      lDPI(1) = GetDeviceCaps(lDC, 90&)               'vert
      lDC = ReleaseDC(0, lDC)
   End If

   ScreenDPI = lDPI(Abs(bVert))

End Function

Private Function PntPixel(Points As Single, bVert As Boolean) As Long
   PntPixel = Points * ScreenDPI(bVert) / 72
End Function

Private Function PixelsToPoints(ByVal Pixels As Double) As Double
    PixelsToPoints = Pixels / 96 * 72
End Function


Public Sub FindMyCenter()
    Application.EnableEvents = False
    
    Dim o As Object
    Dim wnd As Window
    
    Set o = TESTING.OLEObjects("SectionToggle")
    Set wnd = o.TopLeftCell.Parent.Parent.Windows(1)
        
    
    Set PvsCell = ActiveCell
    TESTING.Activate
    wnd.FreezePanes = False
    

    
        
    TOGGLESIDE.Left = PntPixel(o.TopLeftCell.Left * wnd.Zoom / 100, 0) + wnd.PointsToScreenPixelsX(0) + PntPixel(o.Width \ 2, False)
    TOGGLESIDE.Top = PntPixel(o.TopLeftCell.Top * wnd.Zoom / 100, 1) + wnd.PointsToScreenPixelsY(0) + PntPixel(o.Height \ 2, True)
    
    Set o = TESTING.OLEObjects("SetupButton")
    
    SETUPSIDE.Left = PntPixel(o.TopLeftCell.Left * wnd.Zoom / 100, 0) + wnd.PointsToScreenPixelsX(0) + PntPixel(o.Width \ 2, False)
    SETUPSIDE.Top = PntPixel(o.TopLeftCell.Top * wnd.Zoom / 100, 1) + wnd.PointsToScreenPixelsY(0) + PntPixel(o.Height \ 2, True)
       
    Set o = TESTING.OLEObjects("QTIMEButton")
    
    QUESTIONSIDE.Left = PntPixel(o.TopLeftCell.Left * wnd.Zoom / 100, 0) + wnd.PointsToScreenPixelsX(0) + PntPixel(o.Width \ 2, False)
    QUESTIONSIDE.Top = PntPixel(o.TopLeftCell.Top * wnd.Zoom / 100, 1) + wnd.PointsToScreenPixelsY(0) + PntPixel(o.Height \ 2, True)
    
    

    
    TESTING.Activate: TESTING.[TESTING.TIMED.chk.HEADER].Offset(1).Activate: ActiveWindow.FreezePanes = True
    PvsCell.Parent.Activate: Application.GoTo PvsCell: HighlightBLING
    If PvsCell.Parent.Name = "Testing" And ActiveCell.Row > Startrow - 1 Then
        If FIRSTqSUBCheck And QuestionTimeSTART = vbNullString Then ActiveWindow.ScrollRow = ActiveCell.Row Else ActiveWindow.ScrollRow = ActiveCell.Row - TESTING.Cells(ActiveCell.Row, TESTING.[TESTING.Section.Sub.Q.Num.HEADER].Column).Value + 1
    End If
    
    wnd.Parent.Parent.Windows(1).NewWindow 'Clears weird bug
    wnd.Parent.Parent.Windows(1).Close

   SetCursorPos TOGGLESIDE.Left, TOGGLESIDE.Top
End Sub