Scrolling left or right depending on position within active sheet

Hi all,

I'm not sure this is feasible with VBA (hopefully), but I want to "scroll" with the keystroke CTRL + LEFT or RIGHT arrow to a certain position depending on where I am currently on the active sheet.

e.g.

If the scroll position is currently between "Japan Clusters" and "Korea Clusters" the keystroke CTRL + LEFT ARROW should bring me to the "Japan Cluster", meaning the blue column should be the left most visible column. If I press CTRL + RIGHT ARROW it should scroll to the 'Korea Cluster", if I then press CTRL + RIGHT ARROW again, it should move on to the next cluster ("HMT Cluster").

I have attached a sample file to make things more clear. The keystroke CTRL + RIGHT ARROW currently gets you only to the "Japan Cluster" no matter which part of the sheet you're currently looking at!

Sub Next_Cluster()
Dim thiscolumn As Long, mc As Range
thiscolumn = ActiveCell.Column
With Range("2:2")
    Set mc = .Cells.Find("Clusters", after:=Cells(2, thiscolumn), lookat:=xlPart)
    Application.Goto mc, Scroll:=True
End With
End Sub

Sub Previous_Cluster()
Dim thiscolumn As Long, mc As Range
thiscolumn = ActiveCell.Column
With Range("2:2")
    Set mc = .Cells.Find("Clusters", after:=Cells(2, thiscolumn), lookat:=xlPart, searchdirection:=xlPrevious)
    Application.Goto mc, Scroll:=True
End With
End Sub

Kind regards
Leo

This is incredible!! I knew there is a way

The only concern I have after a bit of testing, my actual file has 1500+ rows, so if my clients scroll down to e.g. row number 1000 and then want to move to the next "cluster" it moves them up to row number 2 again! Can the code somehow be adjusted to take into account the rows as well?

Originally Posted by esbencito

I'm not sure this is feasible with VBA (hopefully), but I want to "scroll" with the keystroke CTRL + LEFT or RIGHT arrow to a certain position depending on where I am currently on the active sheet.

e.g.

If the scroll position is currently between "Japan Clusters" and "Korea Clusters" the keystroke CTRL + LEFT ARROW should bring me to the "Japan Cluster", meaning the blue column should be the left most visible column. If I press CTRL + RIGHT ARROW it should scroll to the 'Korea Cluster", if I then press CTRL + RIGHT ARROW again, it should move on to the next cluster ("HMT Cluster").

1) To ThisWorkbook Code Module.

Private Sub Workbook_Activate()
    Application.OnKey "^{LEFT}", "'test ""True""'"
    Application.OnKey "^{RIGHT}", "'test ""False""'"
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "^{RIGHT}", ""
    Application.OnKey "^{LEFT}", ""
End Sub

To a Standard Code Module.

Sub test(flg As String)
    Dim r As Range
    Set r = Rows(2).Find("CLUSTERS", Cells(2, ActiveCell.Column), , 2, , IIf(flg = "True", 2, 1))
    Application.Goto Cells(ActiveCell.Row, r.Column), True
End Sub

Great!! Now it selects the row as well.

Unfortunately, (should have anticipated that) it scrolls the cell to the top left corner. If my clients have e.g. cell DO45 selected, but scrolled to have it centered, the macro still moves the screen down, rather than just right or left. Also, if my clients just scroll rather than select cells, it wouldn't take that into account.

Now the question, in order to make this even better, would be, can the VBA tell where the screen is currently scrolled to and take that as a starting point rather than just ActiveCell.Column?

Change test sub to

Sub test(flg As String)
    Dim r As Range
    Set r = Rows(2).Find("CLUSTERS", Cells(2, ActiveCell.Column), , 2, , IIf(flg = "True", 2, 1))
    Application.Goto Cells(ActiveCell.Row, r.Column)
    ActiveWindow.ScrollColumn = r.Column
End Sub

Hmm... I think it has to be either both parts of the code using "Cell.Select" and "ActiveCell" or both using current window scroll position. A combination of the two doesn't seem to work. In the case above, it doesn't move further to the right or left unless you select a cell again every single time

Originally Posted by esbencito

Hmm... I think it has to be either both parts of the code using "Cell.Select" and "ActiveCell" or both using current window scroll position. A combination of the two doesn't seem to work. In the case above, it doesn't move further to the right or left unless you select a cell again every single time

I don't think I understand what you are trying to do, so I leave this to the other.

Try

Sub Next_Cluster()
Dim thiscolumn As Long, mc As Range, mc2 As Range
thiscolumn = ActiveCell.Column
thisrow = ActiveCell.Row - 1
Set mc = Rows(2).Find("Clusters", after:=Cells(2, thiscolumn), lookat:=xlPart)
Set mc2 = Rows(12).Find("Cluster", after:=Cells(12, mc.Column), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
Application.Goto Cells(mc.Column), Scroll:=True
ActiveCell.Offset(thisrow, thiscolumn - mc2.Column).Activate
End Sub

Sub Previous_Cluster()
Dim thiscolumn As Long, mc As Range
thiscolumn = ActiveCell.Column
thisrow = ActiveCell.Row - 1
Set mc = Rows(2).Find("Clusters", after:=Cells(2, thiscolumn), lookat:=xlPart, searchdirection:=xlPrevious)
Set mc2 = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
Application.Goto Cells(mc.Column), Scroll:=True
ActiveCell.Offset(thisrow, thiscolumn - mc2.Column).Activate
End Sub

Kind regards
Leo

almost!!

It works, but only if the ActiveCell isn't between clusters or at the very left of the sheet. Then it either doesn't move at all or I get a "application defined" error...

Can i know how many columns you see on your screen ?

Kind regards
Leo

Not sure I understand your question correctly, but if I'm at zoom 100% looking at one of the cluster section, I can see 36 columns without having to scroll...

First test this 1, only for previous, if this works i make the next also

Sub Previous_Cluster()
Dim thiscolumn As Long, mc As Range, val1 As Double, mstring As String, lastcl As Range, firstcl As Range
With Rows(12)
    Set firstcl = .Cells.Find("CLUSTER")
    Set lastcl = .Cells.Find("CLUSTER", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
End With
thiscolumn = ActiveCell.Column
thisrow = ActiveCell.Row
If UCase(Cells(12, ActiveCell.Column)) = "CLUSTER" Then
    Set mc2 = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
    If mc2.Column < thiscolumn Then
        Application.Goto Cells(thisrow, mc2.Column), Scroll:=False
    Else
        Application.Goto Cells(, lastcl.Column), Scroll:=True
        ActiveCell.Offset(thisrow - 1).Activate
        Exit Sub
    End If
ElseIf UCase(Cells(12, ActiveCell.Column)) <> "CLUSTER" Then
    mstring = UCase(Cells(12, thiscolumn))
    If Left(mstring, 5) = "STORE" Then
        val1 = Right(mstring, Len(mstring) - 5)
        If Cells(12, thiscolumn - val1).Value = "CLUSTER" Then
            Set mc2 = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn - val1), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
            If mc2.Column < thiscolumn Then
                Application.Goto Cells(, mc2.Column), Scroll:=True
                ActiveCell.Offset(thisrow - 1).Activate
                Application.Goto Cells(ActiveCell.Row, ActiveCell.Column + val1), Scroll:=False
            Else
                Application.Goto Cells(, lastcl.Column), Scroll:=True
                ActiveCell.Offset(thisrow - 1).Activate
                Application.Goto Cells(ActiveCell.Row, ActiveCell.Column + val1), Scroll:=False
                Exit Sub
            End If
        Else
            Set mc2 = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
            Application.Goto Cells(, mc2.Column), Scroll:=True
            ActiveCell.Offset(thisrow - 1).Activate
            Application.Goto Cells(ActiveCell.Row, ActiveCell.Column + val1), Scroll:=False
        End If
    ElseIf Left(mstring, 5) <> "STORE" Then
        Set mc2 = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
        Application.Goto Cells(thisrow, mc2.Column), Scroll:=False
    End If
End If
End Sub

Kind regards
Leo

Thanks Leo!

That does indeed work better than the previous code. Though, not 100% reliable as e.g. it doesn't scroll to the last cluster properly when I am on the very left of the sheet. Also, even though it does select the right cell, it still moves the screen up or down slightly to center (!) the active cell (minor but still a little annoying when comparing data by cluster).

If there isn't a fix for that with this "search for: Cluster" approach. Could below approach work which I used to scroll sheets simultaneously? It gets the current row and column scroll position and applies it to the other sheet when activated. Maybe something similar could work here as well? Or a combination of both? not sure...

https://www.excelforum.com/excel-pro...taneously.html

Think this is it then

Sub Next_Cluster()
Dim thiscolumn As Long, thisrow As Long, mc As Range, val1 As Double, mstring As String
thiscolumn = ActiveCell.Column
thisrow = ActiveCell.Row
mstring = UCase(Cells(12, thiscolumn))
If Left(mstring, 5) = "STORE" Then
    val1 = Right(mstring, Len(mstring) - 5)
    Set mc = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
Else
    Set mc = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
End If
Application.Goto Cells(, mc.Column), Scroll:=True
ActiveCell.Offset(thisrow - 1).Activate
If val1 > 0 Then
    Application.Goto Cells(ActiveCell.Row, ActiveCell.Column + val1), Scroll:=False
End If
End Sub

Sub Previous_Cluster()
Dim thiscolumn As Long, thisrow As Long, mc As Range, val1 As Double, mstring As String
thiscolumn = ActiveCell.Column
thisrow = ActiveCell.Row
mstring = UCase(Cells(12, thiscolumn))
If Left(mstring, 5) = "STORE" Then
    val1 = Right(mstring, Len(mstring) - 5)
    If Cells(12, thiscolumn - val1).Value = "CLUSTER" Then
        Set mc = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn - val1), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
    Else
        Set mc = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
    End If
Else
    Set mc = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
End If
Application.Goto Cells(, mc.Column), Scroll:=True
ActiveCell.Offset(thisrow - 1).Activate
If val1 > 0 Then
    Application.Goto Cells(ActiveCell.Row, ActiveCell.Column + val1), Scroll:=False
End If
End Sub

Kind regards
Leo

Great!!

Only problem here (sorry for not pointing that out earlier), my clusters actually have names, they aren't called "Store 1", but rather "TOP","A","B" and are constantly changing

Capture1.PNG

Next try

Sub Next_Cluster()
Dim thiscolumn As Long, thisrow As Long, mc As Range, val1 As Double
thiscolumn = ActiveCell.Column
thisrow = ActiveCell.Row
Cells(2, thiscolumn).Activate
If Cells(12, ActiveCell.Column) = "CLUSTER" Then
    val1 = thiscolumn - ActiveCell.Column
Else
    val1 = (thiscolumn - ActiveCell.Column) + 1
End If
Set mc = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
Application.Goto Cells(, mc.Column), Scroll:=True
ActiveCell.Offset(thisrow - 1).Activate
If val1 > 0 Then
    Application.Goto Cells(ActiveCell.Row, ActiveCell.Column + val1), Scroll:=False
End If
End Sub

Sub Previous_Cluster()
Dim thiscolumn As Long, thisrow As Long, mc As Range, val1 As Double, mstring As String
thiscolumn = ActiveCell.Column
thisrow = ActiveCell.Row
Cells(2, thiscolumn).Activate
If Cells(12, ActiveCell.Column) = "CLUSTER" Then
    val1 = thiscolumn - ActiveCell.Column
    Set mc = Rows(12).Find("Cluster", after:=Cells(12, ActiveCell.Column), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
Else
    val1 = (thiscolumn - ActiveCell.Column) + 1
    Set mc = Rows(12).Find("Cluster", after:=Cells(12, thiscolumn), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
End If
Application.Goto Cells(, mc.Column), Scroll:=True
ActiveCell.Offset(thisrow - 1).Activate
If val1 > 0 Then
    Application.Goto Cells(ActiveCell.Row, ActiveCell.Column + val1), Scroll:=False
End If
End Sub

Cheers
Leo

Btw, if someone else has a different solution than the above, I would still be interested in seeing them to learn more about VBA in particular regarding scrolling without selecting or deselecting cells

e.g.

https://www.excelforum.com/excel-pro...taneously.html

Awesome!! Thanks! That finally works

I like your solution with activating the cell in Row (2) first, then finding the string "Cluster". Makes it quite easy to apply it to other cases by merging cells and finding common strings in each section of the sheet.