Reputation: 23
I am attempting to create a dynamic named range that is dependent on the current ActiveCell
. The data set has two strokes (Extend/Retract), and each stroke has a unique data sample rate, so the height fluctuates for every stroke and resets at 1 indicating the beginning of a new stroke. The last column of the data set has a token indicating direction traveled at the end of each row (see pic).
The idea was to wrap the code in a Spin Button (ActiveX Control) and allow the user to scroll up or down the data set charting only the data relevant to that cycle.
I have been able to extract the ActiveCell.Address
and store it in a cell on the sheet, but using it as a reference in an Offset
was nonviable since it's a string.
ws1.Range("AI1").Value = ActiveCell.Address
Alternatively, I extracted the current ActiveCell.Row
(data begins at row 8) to determine the height of the `Offset' (needn't worry about columns, they are constant)
ws1.Range("AI2").Value = ActiveCell.Row - 7
While this does work for the first set, the named range grows to include the next stroke and the previous stroke. This needs to be subtracted off...
In a different approach, I used a recorded Macro to simulate highlighting the blank rows between the used rows. This does offer a correct count, but I am unsure how to exploit this...
Range(Selection, Selection.End(xlDown)).Select
In short, I would like to to count the number of blank cells between the text in the T
column simulating ctrldwn
and create a named range that references the ActiveCell.address
as the starting point and the number of cells between text.
Any alternative approaches or suggestions will be met with gratitude.
Upvotes: 1
Views: 1476
Reputation: 2819
Assuming there is a SpinButton1 in the sheet, i've created this code:
Private Sub SubSpin()
'Declaring variables.
Dim RngTop As Range
Dim IntCounter01 As Integer
Dim RngBottom As Range
Dim StrName As String
'Setting variable.
StrName = "Section"
'Resetting the SpinButton1 maximum value.
SpinButton1.Max = Cells.Rows.Count
'Checkpoint.
RestartLoop1:
'Setting variables.
Set RngTop = Range("T8")
Set RngBottom = RngTop.End(xlDown)
'Using a Do-Loop cycle to cover the entire list.
Do Until IntCounter01 >= SpinButton1.Value
'Checking if the code is about to pass the last row of the sheet.
If RngTop.End(xlDown).Row = Cells.Rows.Count Then
'Setting the maximum value of SpinButton1.
SpinButton1.Max = SpinButton1.Value - 1
'Quitting the loop.
GoTo ExitLoop1
End If
'Setting variables.
Set RngTop = RngTop.End(xlDown).Offset(1, 0)
Set RngBottom = RngTop.End(xlDown)
IntCounter01 = IntCounter01 + 1
Loop
'Checkpoint.
ExitLoop1:
'Naming the found range.
ActiveWorkbook.Names.Add Name:=StrName, RefersToR1C1:="=Foglio1!R" & RngTop.Row & "C20:R" & RngBottom.Row & "C20"
'Checking if the range is empty.
If Excel.WorksheetFunction.CountBlank(Range(StrName)) = Range(StrName).Cells.Count Then
'Setting variables to select the previous range.
IntCounter01 = 0
SpinButton1.Value = SpinButton1.Value - 1
'Restarting the loop.
GoTo RestartLoop1
End If
'Setting variables.
Range("AI1").Value = SpinButton1.Value
Range("AI2").Value = Range(StrName).Address
End Sub
Private Sub SpinButton1_SpinDown()
Call SubSpin
End Sub
Private Sub SpinButton1_SpinUp()
Call SubSpin
End Sub
It creates a name referred to the section "selected" via the spinbutton. It also prints in cell AI1 the current value of SpinButton1 while in cell AI2 it prints the given range. The code prevents the selection of a blank section and the overshooting of the last cell in the sheet. The spinbutton has a minimum value of 0. I'd sugget to set its SmallChange property to -1 to make it more intuitive for the user.
Upvotes: 0
Reputation: 55073
SpinUp
and SpinDown
events of the spin button (often it runs the procedures twice, like it has been clicked twice).TakeFocusOnClick
in the command buttons to False
Select Case
statements should be self explanatory.The If Statements
Up
is 'used', then at the intersection of one row above the ActiveCell
's row and the criteria column, it checks if the value is equal to criteria. If so, searching up starting from the cell above, tries to find the criteria. If found, scrolls to one row below the found cell and activates the cell in the initially saved column of the ActiveCell
in it. If criteria is not found, it scrolls to the cell defined by the sixth (The header is in the fifth row and five rows are frozen) row and the initially saved column of the ActiveCell
.Down
is 'used', then at the intersection of one row below the ActiveCell
's row and the criteria column, it checks if the value is equal to criteria. If so, searching down starting from the cell below, tries to find the criteria. If found, scrolls to one row below the found cell and activates the cell in the initially saved column of the ActiveCell
in it. If criteria is not found, it tries to find the criteria searching from the cell one row below to the bottom of the column. If found, , scrolls to one row below the found cell and activates the cell in the initially saved column of the ActiveCell
in it. Otherwise exits the procedure.The Flow
DirUp
or DirDown
, which are calling the changeDirection
procedure which when necessary calls the defineFoundCell
procedure.Standard Module e.g. Module1
Option Explicit
Sub changeDirection(ByVal Criteria As String, _
Optional ByVal ignoreCase As Boolean = False, _
Optional ByVal ColumnIndex As Variant = 1, _
Optional ByVal FirstRow As Long = 1, _
Optional ByVal goUp As Boolean = False, _
Optional Sheet As Worksheet = Nothing)
' Initialize error handling.
Const ProcName = "changeDirections"
On Error GoTo clearError ' Turn on error trapping.
If Sheet Is Nothing Then
Set Sheet = ActiveSheet
End If
Dim cel As Range
Set cel = Sheet.Cells(ActiveCell.Row, ColumnIndex)
Dim ActiveColumnNumber As Long
ActiveColumnNumber = ActiveCell.Column
Dim rng As Range
Dim ScrollToRow As Long
If goUp Then
Select Case cel.Row
Case Is < FirstRow ' 'ActiveCell' is above 'FirstRow'.
GoTo ProcExit
Case Is = FirstRow ' 'Activecell' is in 'FirstRow'.
GoTo ProcExit
Case Else ' 'ActiveCell' is below 'FirstRow'. Continue...
End Select
If cel.Offset(-1).Value = Criteria Then
defineFoundCell rng, cel.Offset(-2), Criteria, ignoreCase, _
False, FirstRow
Else ' cel.Offset(-1).Value <> Criteria
defineFoundCell rng, cel.Offset(-1), Criteria, ignoreCase, _
False, FirstRow
End If
If rng Is Nothing Then
ScrollToRow = FirstRow
Else
ScrollToRow = rng.Row + 1
End If
Else ' (goDown)
Select Case cel.Row
Case Is < FirstRow ' 'ActiveCell' is above 'FirstRow'.
ScrollToRow = FirstRow
GoTo selectCellRange
Case Is = FirstRow ' 'Activecell' is in 'FirstRow'. Continue...
Case Else ' 'ActiveCell' is below 'FirstRow'. Continue...
End Select
If cel.Offset(1).Value = Criteria Then
ScrollToRow = cel.Row + 2
Else
defineFoundCell rng, cel.Offset(1), Criteria, ignoreCase, _
True, FirstRow
If rng Is Nothing Then
GoTo ProcExit
Else
ScrollToRow = rng.Row + 1
End If
End If
End If
selectCellRange:
Sheet.Cells(ScrollToRow, ActiveColumnNumber).Activate
ActiveWindow.ScrollRow = ScrollToRow
ProcExit:
Exit Sub
clearError:
Debug.Print "'" & ProcName & "': " & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
On Error GoTo 0 ' Turn off error trapping.
GoTo ProcExit
End Sub
Sub defineFoundCell(ByRef FindCellRange As Range, _
InitialCellRange As Range, _
ByVal Criteria As String, _
Optional ByVal ignoreCase As Boolean = False, _
Optional ByVal getAfterInitialCell As Boolean = False, _
Optional ByVal FirstRow As Long = 1, _
Optional ByVal ColumnIndex As Variant = 1)
' Initialize error handling.
Const ProcName = "defineFoundCell"
On Error GoTo clearError ' Turn on error trapping.
Set FindCellRange = Nothing
Dim ws As Worksheet: Set ws = InitialCellRange.Worksheet
Dim FirstCell As Range
Dim LastCell As Range
If getAfterInitialCell Then
Set FirstCell = InitialCellRange
Set LastCell = ws.Cells(ws.Rows.Count, ColumnIndex)
Set FindCellRange = ws.Range(FirstCell, LastCell) _
.Find(What:=Criteria, _
After:=LastCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=Not ignoreCase)
Else ' getAfterInitialCell = False
Set FirstCell = ws.Cells(FirstRow, ColumnIndex)
Set LastCell = InitialCellRange
Set FindCellRange = ws.Range(FirstCell, LastCell) _
.Find(What:=Criteria, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _
MatchCase:=Not ignoreCase)
End If
ProcExit:
Exit Sub
clearError:
Debug.Print "'" & ProcName & "': " & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
On Error GoTo 0 ' Turn off error trapping.
GoTo ProcExit
End Sub
Sheet Module e.g. Sheet1
Option Explicit
Private Const Criteria As String = "Extend"
Private Const CriteriaColumnID As Variant = "T" ' or 20
Private Const FirstRow As Long = 6
Sub DirUp()
changeDirection Criteria, , CriteriaColumnID, FirstRow, True, Me
End Sub
Sub DirDown()
changeDirection Criteria, , CriteriaColumnID, FirstRow, , Me
End Sub
Private Sub CommandButton1_Click()
DirUp
End Sub
Private Sub CommandButton2_Click()
DirDown
End Sub
Private Sub SpinButton1_SpinUp()
DirUp
End Sub
Private Sub SpinButton1_SpinDown()
DirDown
End Sub
Upvotes: 0
Reputation: 14383
To put it mildly, I haven't been very good at understanding your picture. So, on another approach, I tried to find a way to exploit the solution you already found but failed to find the end toward which it surely could be exploited.
Basically, one wouldn't store anything on the sheet that isn't supposed to be saved. Any number of any type of variable can be stored in memory. It will be lost when Excel is shut down or the program comes to an end.
Dim aCell As Range
Set aCell = Activecell
This code will create a variable of Range
datatype to which it then assigns the the ActiveCell
object which will remain unchanged even if the ActiveCell changes. You can use aCell
in any way you might use ActiveCell
, such as
Debug.Print aCell.Address, aCell.Row
Set MyRange = Range(aCell, aCell.Offset(17))
Observe that you can always create a range object if you have an address. Set MyCell = ActiveSheet.Range("A3")
creates such an object and aCell.Value = MyCell.Address
reverses the process. Use the Set
word to assign an object, not required for strings or numbers.
Selection
is a range object. Therefore it has all the properties of a range.
Dim sRange As Range
Set sRange = Selection
Debug.Print sRange.Address(0, 0)
Set sRange = sRange.Resize(15)
Debug.Print sRange.Address, sRange.Worksheet.Name
I hope this will let you move up one step.
Upvotes: 0