Scrolling through visible rows using SPINBUTTOn

[haplc]

Hi there

I am using SPIN button (SB2) to scroll through the excel sheet table. Data of filtered rows is also being displayed in text boxes (please see code below)
Issue is I want to scroll through only the visible rows. with the code it is checking every row (i.e. 1.2.3...)- instead I would like to have in such a way that spinbox scroll only visible rows i.e 1, 4, 7 (as only rows 1, 4 and 7 are visibile after applying filters)
Thanks in advance

Private Sub SB2_Change()
'SB2 is name of Spin button

SB2.Min = 2 'defining minimum value. Row 1 is header

CellNr = SB2.Value

If ActiveWorkbook.Sheets("Sheet1").Range("a" & CellNr) = "" Then

MsgBox "you have reached the end of record"
TextBox4.Text = "End of record"
TextBox5.Text = "End of record"

' getting the data of visibile rows only on text box

ElseIf ThisWorkbook.Sheets("sheet1").Rows(CellNr).Hidden = False Then

TextBox6.Text = SB2.Value
TextBox4.Text = ActiveWorkbook.Sheets("Sheet1").Range("A" & CellNr).Value
TextBox5.Text = ActiveWorkbook.Sheets("Sheet1").Range("b" & CellNr).Value
End If


End Sub

 

[RickXL]

Hi,

Good puzzle

There does not seem to be a good way to do this. I am sure someone will point it out if there is a better way than the one I have chosen.

When you hide rows you can use SpecialCells(xlCellTypeVisible) to locate the ones you can still see. That will give you a range that is split into Areas. So what I did was to work out which Row of which Area the spin button was trying to point to.

I made a change to the SpinButton min and max so that the min is always 1 and the max is the number of visible data rows. This means that the button will stop scrolling when it reaches the end of the data.

You now have a choice for TextBox6. You can either use the worksheet row number or the number from the SpinButton.

The code looks like this:

Private Sub SB2_Change()

    Dim rng As Range, r As Range
    Dim lr As Long, iRow As Long, iArea As Long, i As Long, n As Long
    Dim flg As Boolean
    
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("A2:A" & lr).SpecialCells(xlCellTypeVisible)
    
    For i = 1 To rng.Areas.Count
        If (n + rng.Areas(i).Rows.Count) >= SB2.Value And Not flg Then
            iArea = i
            iRow = SB2.Value - n
            flg = True
        End If
        n = n + rng.Areas(i).Rows.Count
    Next
    
    SB2.Min = 1
    SB2.Max = n
    
    With rng.Areas(iArea)
        TextBox6.Text = .Cells(iRow, "A").Row 'SB2.Value
        TextBox4.Text = .Cells(iRow, "A").Value
        TextBox5.Text = .Cells(iRow, "B").Value
    End With

End Sub

 

[haplc]

Thanks a lot---it works
I have used CellNr =textbox6.text and was oK

 

[RickXL]

Hi,

In line with our policy of continuous product improvement ...

I found a couple of bugs in the previous version. They only happen when you filter out more rows and then re-start scrolling.

I also wanted to see which line was the active one so I added a blue highlighting line. You could remove that if you don't like it.

Private Sub SB2_Change()

    Dim rng As Range
    Dim iRow As Long, iArea As Long, i As Long, n As Long, j As Long, scrRow As Long

    Set rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    rng.EntireRow.Interior.Pattern = xlNone
    Set rng = rng.SpecialCells(xlCellTypeVisible)
    
    For i = 1 To rng.Areas.Count
        n = n + rng.Areas(i).Rows.Count
    Next
    
    If SB2.Value > n Then SB2.Value = 1
    
    SB2.Min = 1
    SB2.Max = IIf(n = 1, 2, n)
    
    For i = 1 To rng.Areas.Count
        If (j + rng.Areas(i).Rows.Count) >= SB2.Value Then
            iArea = i
            iRow = SB2.Value - j
            Exit For
        End If
        j = j + rng.Areas(i).Rows.Count
    Next
     
    With rng.Areas(iArea)
        scrRow = .Cells(iRow, "A").Row          ' For Scrolling
        .Cells(iRow, "A").EntireRow.Interior.Color = RGB(204, 255, 255)
        TextBox6.Text = .Cells(iRow, "A").Row
        TextBox4.Text = .Cells(iRow, "A").Value
        TextBox5.Text = .Cells(iRow, "B").Value
    End With
    
    With ActiveWindow
         If scrRow >= (.VisibleRange.Row + .VisibleRange.Rows.Count - 3) Then .ScrollRow = scrRow - .VisibleRange.Rows.Count + 3
         If scrRow < .VisibleRange.Row Then .ScrollRow = scrRow
    End With
    
End Sub

 

[haplc]

Many thanks.....works perfectly fine. In fact, with the last code was hanging at times but new one not stuck so far.
I appreciate the idea of highlighting the row with blue color
Thanks