Help with Excel Scroll Bar and %

[maximillianrg]

I do not know if the following is possible in Excel but here is what I am trying to do

Cell C2 = 40% which is auto calculated from another data set
Cell D2 = 50%
Cell E2 = 10% and is calculated using =100%-(C2+D2)

I would like to make a scroller that will adjust the # in D2 with the following limitations:
- The min value is 5%
- The max value 100%-C2 s0 40%

To Create this I am guessing I use the ActiveX Scroll Bar but I am not sure what numbers I need in the Properties or if I need to add some VB Code

 

[OaklandJim]

What are the values in C2 and D2? I'll try to assist but no promises. Note that, unfortunately, the "Active X" control needed is notorious for changing size without any apparent reason. This has been an issue for years. Shame on Microsoft for not fixing this. That said, I'll do what I can to mitigate that issue: Each time the control is clicked the size is reset.

 

[OaklandJim]

I think that I have a solution for you. Built-in Excel controls either have issues or will not accomplish what you want. So I built a control from shapes -- two squares and two triangles. As best I can tell it does what is needed.

The workbook is here: Button For Cell Change.xlsm

Here is the code behind the button.

Option Explicit

Sub UpArrow1()

'   Worksheet where the button is located
    Dim wsSource As Worksheet

'   Three cells: 1. static value cell, 2. changing value cell,
'   3. result value cell
    Dim rStaticCell As Range
    Dim rChangingCell As Range
    Dim rResultCell As Range

'   Value for control's .Min property.
    Dim iMinValue As Long
    
    Dim iCurrentValue As Long
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Set wsSource = Worksheets("Sheet1") '<= change this if the name of the worksheet
'                                           containing the cells changes.
    With wsSource
    
'       Cell containing the static input value.
        Set rStaticCell = .Range("C2") '<= change this if the cell containing
'                                          the static value is relocated.
    
'       Cell containing the input value that changes.
        Set rChangingCell = .Range("D2")  '<= change this if the cell containing
'                                             the changing value is relocated.
    
'       Cell containing the result.
        Set rResultCell = .Range("E2")  '<= change this if the cell containing
'                                           the result value is relocated.
    End With

    iMinValue = 5 '<= change this if the minimum value changes.
    
    iCurrentValue = rChangingCell.Value

'   Check for condition: changing value  + 1 + static value > 100,
    If iCurrentValue + 1 + rStaticCell.Value > 100 _
     Then
        rChangingCell.Value = iCurrentValue
    Else
        rChangingCell.Value = rChangingCell.Value + 1
    End If
    
    Application.EnableEvents = True
    
End Sub

Option Explicit

Sub DownArrow1()
    
'   Worksheet where the button is located
    Dim wsSource As Worksheet

'   Three cells: 1. static value cell, 2. changing value cell,
'   3. result value cell
    Dim rStaticCell As Range
    Dim rChangingCell As Range
    Dim rResultCell As Range
    
'   Value for control's .Min property.
    Dim iMinValue As Long
    
    Dim iCurrentValue As Long
    
    Dim iCurrentResult As Long

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Set wsSource = Worksheets("Sheet1") '<= change this if the name of the worksheet
'                                           containing the cells changes.
    With wsSource
    
'       Cell containing the static input value.
        Set rStaticCell = .Range("C2") '<= change this if the cell containing
'                                          the static value is relocated.
    
'       Cell containing the input value that changes.
        Set rChangingCell = .Range("D2")  '<= change this if the cell containing
'                                             the changing value is relocated.
    
'       Cell containing the result.
        Set rResultCell = .Range("E2")  '<= change this if the cell containing
'                                           the result value is relocated.
    End With
    
    iMinValue = 5 '<= change this if the minimum value changes.
    
    iCurrentValue = rChangingCell.Value
    
    iCurrentResult = rResultCell.Value

'   Check for two conditions: 1. result cell value -1 < 0, and
'   2. changing cell < 5
    If iCurrentResult - iCurrentValue = 0 _
     Then
        rChangingCell.Value = iCurrentValue
    ElseIf iCurrentValue - 1 < iMinValue _
     Then
        rChangingCell.Value = iCurrentValue 'i.e., do nothing
    Else
        rChangingCell.Value = iCurrentValue - 1
    End If
    
    Application.EnableEvents = True

End Sub