VBA loop that centers the screen at every 8th row of column C (C8, C16, C24 etc...)

absundo

New Member
Joined
Jan 30, 2015
Messages
23
Hello,

Currently I have a worksheet with around 50 charts one below the other and each chart is around 16 rows in height. I am in the process of creating a macro that scrolls through each active chart where it will perform some calculations and make adjustments to the chart. I have figured out a way to loop through the charts and perform these adjustments - however, I want to implement another code where the user can see the chart update in real time. Currently when I run the loop, the screen stays in one location.

I found the following code on this website:
HTML:
http://www.cpearson.com/excel/zoom.htm

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")
If you pass in a range containing more than one cell, the entire range will be centered on the screen.

This Code only works for a cell range that a user specifies.
How would you implement a part where the code automatically assigns the every 8th range of column C and sends it to the code above so that the screen centers at that range. So range C8 would be sent and the screen would be centered at C8, then range C16 would be centered, then C24 would be centered etc.

Thank you
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

L. Howard

Well-known Member
Joined
Oct 16, 2012
Messages
4,514
Hi absundo,

Not an actual solution, perhaps will give you something to work with.

Where you run sub LHK and it will center on the cells in the array and show a message box the active cell address.

I am unsure how to advise using within your updating code, perhaps the array code alone, (no Sub()/End Sub) at the beginning of the loop that loops through your charts ...?

Howard

Code:
Sub LHK()
Dim MyArr As Variant
Dim i As Long

MyArr = Array("C8", "C16", "C24", "C32") '/ and other cells as necessary
    
    For i = LBound(MyArr) To UBound(MyArr)
    
    CenterOnCell Range(MyArr(i))
    
    Next
End Sub



Sub CenterOnCell(OnCell As Range)

Dim VisRows As Integer
Dim VisCols As Integer

Application.ScreenUpdating = False

OnCell.Parent.Parent.Activate
OnCell.Parent.Activate

With ActiveWindow.VisibleRange
    VisRows = .Rows.Count
    VisCols = .Columns.Count
End With

Application.GoTo OnCell, Scroll:=True

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

MsgBox ActiveCell.Address '// Used to check the centering
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,130,047
Messages
5,639,766
Members
417,109
Latest member
996

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top