• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Data Validation Zoom VBA (need scroll added)

Hi


I am working on a dashboard and have a few data validation drop down lists on it. The problem is that when I click on the drop down list, the font is so tiny that its hard to read, and therefore not user friendly.


I found this code online to help my problem, what it does is zoom into the screen If a data validation dropdown is selected (simple code, not the complicated version, this is just targeting the cells that I have listed in the code rather than ALL DV):


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


If Target.Cells.Count > 1 Then Exit Sub


If Intersect(Target, Range("B4,C4,D4,E4,B17,B30,T15,T3")) Is Nothing Then

ActiveWindow.Zoom = 70


Else

ActiveWindow.Zoom = 120


End If


End Sub


Now this works beautifully, I just need 1 extra thing and that is to say that IF cell T15 is selected and the zoom happens, then to scroll to the right slightly to centralise the screen.


Also I need it so that if these cells aren't selected then when the ActiveWindow.Zoom = 70 happens, then the screen to scroll all the way to the left and all the way up, so that the dashboard is in its original position.


What I have attempted was recording macros to scroll up down left right to see the code, then put it into my VBA but its just not working:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


If Target.Cells.Count > 1 Then Exit Sub


If Intersect(Target, Range("B4,C4,D4,E4,B17,B30,T15,T3")) Is Nothing Then

ActiveWindow.Zoom = 70


Else

ActiveWindow.Zoom = 120


ActiveWindow.SmallScroll ToLeft = 60


ActiveWindow.SmallScroll up = 60


End If


End Sub


Any thoughts? Thanks people!


EJ
 
So I updated the code:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


Application.ScreenUpdating = False

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Range("B4,C4,D4,E4,B17,B30,T3,T15")) Is Nothing Then

ActiveWindow.Zoom = 70

ActiveWindow.ScrollColumn = 1

ActiveWindow.ScrollRow = 1


Else

ActiveWindow.Zoom = 120


End If


Application.ScreenUpdating = True


End Sub


Now what this does is reset the position of the screen back to default so that the dashboard can be seen as it should be seen.


What I need is to split the VBA code, so that if T3/T15 are selected, then the screen to scroll right so that you can actually see the Drop Down lists, and if B17,B30 are selected, then for the screen to scroll down, again so you can see the lists.


Any insights?
 
Back
Top