How to change Excel cell's value with a mouse only?

Question

I would like to be able to easily change cells value (constants, not formulas) with a mouse only, without typing new value with a keyboard.

Such a scrollbar would allow users to observe dynamically what happens with other formulas and charts.

After clicking on a cell which contains a value, some scrollbar (or other device) shows up below the cell (or right to the cell). It would be possible to change the value of the cell with mouse only using this device. It should be possible to define the min and max values of the scrollbar. If not defined the min and max values should be assumed as i.e. 30% (min) and 170% (max) of the current value. When clicking on another cell the "old" scrollbar disappears and a new one shows up below the clicked cell. There should be a possibility to define cell for which scrollbar shows up (for other cells it would not).

I need something else than ordinary Excel scrollbar which changes ONLY ONE cell's value and I do not want to have hundred of scrollbars scattered all over my sheet.

From my research I found out that I can set up events in the worksheet or workbook that will respond to a cell being selected. I can check whether that cell is one that is allowed to display the scrollbar. If so, I can have my code either create a new scrollbar, or make an existing one visible, and locate the scrollbar below the active cell. Changing the scrollbar could affect the cell's value. Some control over how the value changes is needed, to avoid values with 15 decimal digits. When the cell is deselected, the scrollbar can be destroyed, or hidden until its next use.

Update

I have submitted an answer to my question. Now I look forward to improving the speed of my tool.

Update 2

Here are some follow up proposals of improving the performance of my tool

Answer 1

In this solution the Workbook and ScrollBar are bound together into one class ScrollValue. In Workbook_Open event handler the instance of this class is created.

' ------------------------------------
' ThisWorkbook class module
' ------------------------------------
Option Explicit

Public ScrollValueWidget As ScrollValue

Private Sub Workbook_Open()
    Set ScrollValueWidget = New ScrollValue
    ScrollValueWidget.Max = 1000
    ScrollValueWidget.Min = 0
    ScrollValueWidget.Address = "C3:D10"
    ScrollValueWidget.DeleteScrollBars
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set ScrollValueWidget = Nothing
End Sub

ScrollValue class takes care of the ScrollBar and it handles SheetSelectionChange event for all the sheets in workbook in one place. After cell has changed the scroll bar is shown and linked to the changed cell. Scroll bar becomes min and max limits. Value of scroll bar is automatically set acording to target cell value. If the actual cell value exceeds the min-max range a warning is shown.

Scrollbars class uses a OLEObjects collection. For each sheet it has its own scroll bar. So for each sheet only one scroll bar exists at a time.

Note: the value of ScrollBars Value property can't be negative. Set the instancing property of class ScrollValue to PublicNotCreatable.

' ------------------------------------
' ScrollValue class module
' ------------------------------------

Option Explicit

Private minValue As Long
Private maxValue As Long
Private applyToAddress As String
Private WithEvents book As Workbook
Private scroll As OLEObject
Private scrolls As ScrollBars

Private Sub Class_Initialize()
    Set book = ThisWorkbook
    Set scrolls = New ScrollBars
End Sub

Private Sub Class_Terminate()
    Set scrolls = Nothing
    Set book = Nothing
End Sub

Private Sub book_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo ErrSheetSelectionChange

    Set scroll = scrolls.GetOrCreate(Sh) ' Get scroll for targer sheet
    Move Target ' Move scroll to new target cell

    Exit Sub

ErrSheetSelectionChange:
    MsgBox Err.Description, vbCritical
End Sub

Private Sub Move(targetRange As Range)
    ' Do not handle scroll for cells with formulas, not numeric or negative values
    If targetRange.HasFormula Then _
        Exit Sub

    If Not IsNumeric(targetRange.Value) Then _
        Exit Sub

    If targetRange.Value < 0 Then _
        Exit Sub

    If Application.Intersect(targetRange, ApplyToRange(targetRange.Worksheet)) Is Nothing Then _
        Exit Sub

    ' TODO: add code to handle when min/max not defined

    On Error GoTo ErrMove

    ' Move scroll to new target cell and show it
    With scroll
        .Top = targetRange.Top
        .Left = targetRange.Left + targetRange.Width + 2
        .Object.Min = Min
        .Object.Max = Max
        .LinkedCell = targetRange.Address
        .Visible = True
    End With

    Exit Sub

ErrMove:
    Dim errMsg As String
    errMsg = "Max = " & Max & " Min = " & Min & " Cell value = " & targetRange.Value & " must be between <Min, Max>." & Err.Description
    MsgBox errMsg, vbExclamation, "Scroll failed to show"
End Sub

Public Property Get Min() As Long
    Min = minValue
End Property

Public Property Let Min(ByVal newMin As Long)
    If newMin < 0 Then _
        Err.Raise vbObjectError + 1, "ScrollValue", "Min value musn't be less then zero"
    If newMin > maxValue Then _
        Err.Raise vbObjectError + 2, "ScrollValue", "Min value musn't be greater then max value"
    minValue = newMin
End Property

Public Property Get Max() As Long
    Max = maxValue
End Property

Public Property Let Max(ByVal newMax As Long)
    If newMax < 0 Then _
        Err.Raise vbObjectError + 3, "ScrollValue", "Max value musn't be less then zero"
    If newMax < minValue Then _
        Err.Raise vbObjectError + 4, "ScrollValue", "Max value musn't be less then min value"
    maxValue = newMax
End Property

Public Property Let Address(ByVal newAdress As String)
    If newAdress = "" Then _
        Err.Raise vbObjectError + 5, "ScrollValue", "Range address musn't be empty string"
    applyToAddress = newAdress
End Property

Public Property Get Address() As String
    Address = applyToAddress
End Property

Private Property Get ApplyToRange(ByVal targetSheet As Worksheet) As Range
    ' defines cell(s) for which scrollbar shows up
    Set ApplyToRange = targetSheet.Range(Address)
End Property

Public Sub DeleteScrollBars()
    scrolls.DelateAll
End Sub

' ------------------------------------
' ScrollBars class module
' ------------------------------------

Option Explicit

Private Const scrollNamePrefix As String = "ScrollWidget"

Private Sub Class_Terminate()
    DelateAll
End Sub

Private Function ScrollNameBySheet(ByVal targetSheet As Worksheet) As String
    ScrollNameBySheet = scrollNamePrefix & targetSheet.name
End Function

Public Function GetOrCreate(ByVal targetSheet As Worksheet) As OLEObject
    Dim scroll As OLEObject
    Dim scrollName As String

    scrollName = ScrollNameBySheet(targetSheet)

    On Error Resume Next
    Set scroll = targetSheet.OLEObjects(scrollName)
    On Error GoTo 0

    If scroll Is Nothing Then
        Set scroll = targetSheet.OLEObjects.Add(ClassType:="Forms.ScrollBar.1", _
            Left:=0, Top:=0, Width:=250, Height:=16)
        scroll.name = scrollName
        scroll.AutoLoad = True
        scroll.Object.Orientation = fmOrientationHorizontal
        scroll.Object.BackColor = &H808080
        scroll.Object.ForeColor = &HFFFFFF
    End If

    scroll.Enabled = True
    scroll.Locked = False
    scroll.LinkedCell = ""
    scroll.Visible = False

    Set GetOrCreate = scroll
End Function

Public Sub DelateAll()
    ' Deletes all scroll bars on all sheets if its name beginns with scrollNamePrefix

    Dim scrollItem As OLEObject
    Dim Sh As Worksheet

    For Each Sh In Worksheets
        For Each scrollItem In Sh.OLEObjects
            If scrollItem.name Like scrollNamePrefix & "*" Then
                scrollItem.Locked = False
                scrollItem.delete
            End If
        Next scrollItem
    Next Sh
End Sub

Watch ScrollValue in action: youtube video

Answer 2

This is complete tool

You can download the scrollbar.xlsm file here:

It is two years after I posted the question. I have come up with the following solution. I have not shared it before in order to get fresh concepts of tackling the problem. In my experience the feature of changing cell value with a mouse arouse sometimes more impression on the audience than complex models and calculations in the sheet :-)

Put this code in your sheet where you want the scrollbars to appear. The name of your sheet does not matter. Right click on the sheet's name and then click View Code. This is the place:

Insert there this code:

Option Explicit
Dim previousRow, c
Const scrlName As String = "scrlSh" ' the name of the scrollbar


Private Sub scrlSh_GotFocus()
    ActiveSheet.Range(ActiveSheet.OLEObjects(scrlName).TopLeftCell.Offset(0, -1).Address).Activate
End Sub

Private Sub scrlSh_Scroll()
Dim rngCell As Range

Set rngCell = Sheets("Param").Range(ActiveSheet.OLEObjects(scrlName).LinkedCell)

    ActiveSheet.OLEObjects(scrlName).TopLeftCell.Offset(0, -1).Value = _
        rngCell.Offset(0, 1).Value + (ActiveSheet.OLEObjects(scrlName).Object.Value * rngCell.Offset(0, 3).Value)

Set rngCell = Nothing
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Macro concept by Przemyslaw Remin, VBA code written by Jaroslaw Smolinski
' The Sub Worksheet_SelectionChange and function SearchAdr have to be on each sheet where scrollbars are to appear
' Sheet Param is one for all sheets, only the columns A-G are used, othre columns can be used for something else
' Do not change the layout of A-G columns unless you want to modify the code
' Addresses in Param have to be with dollars (i.e. $A$3) or it may be named ranges of single cells
' (if it starts with $ it is a cell, otherwise it is a named range)
' the lower or upper case in addresses does not matter


Dim SheetFly As String, adr As String
Dim cCell As Range
Dim actSheet As Worksheet
Dim shScroll As Object

    Set actSheet = ActiveSheet

    ' checks if scrollbar exists
    If actSheet.Shapes.Count > 0 Then
        For Each shScroll In actSheet.Shapes
            If shScroll.Type = msoOLEControlObject And shScroll.Name = scrlName Then
                Exit For ' scrollbar found, and the variable is set
            End If
        Next shScroll
    End If
    ' if scrollbar does not exists then it is created
    If shScroll Is Nothing Then
        Set shScroll = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ScrollBar.1", Link:=False, _
            DisplayAsIcon:=False, Left:=0, Top:=0, Width:=64 * 3, Height:=15)
            ' scrollbar length is set as three adjesent columns
        shScroll.Visible = False
        shScroll.Name = scrlName
        shScroll.Placement = xlMoveAndSize
    End If

    shScroll.Visible = False
    adr = Target.AddressLocal
    SheetFly = actSheet.Name


    ' here we set up in which cells the scrollbar has to appear. We set up only the number of rows
    Set cCell = SearchAdr(SheetFly, adr, Sheets("Param").Range("B2:B40")) ' If needed it can be longer i.e. B2:B400
    If Not cCell Is Nothing Then
        With ActiveSheet.OLEObjects(scrlName)
            .LinkedCell = "" ' temporary turn off of the link to the cell to avoid stange behaviour
            .Object.Min = 0 ' the scale begins from 0, not negative
            .Object.Max = Abs((cCell.Offset(0, 4).Value - cCell.Offset(0, 3).Value) / cCell.Offset(0, 5).Value)
            .Object.SmallChange = 10   ' single change by one step
            .Object.LargeChange = 10   ' change by jumps after clicking on scrollbar bar ("page up", "page down")
            If Target.Value <> cCell.Offset(0, 2).Value And Target.Value >= cCell.Offset(0, 3).Value And Target.Value <= cCell.Offset(0, 4).Value Then
                ' setting up the cells value as close as possible to the value of input by hand
                ' rounded by step
                ' if value is out of defined range then the last value will be used
                cCell.Offset(0, 2).Value = Abs((Target.Value - cCell.Offset(0, 3).Value) / cCell.Offset(0, 5).Value)
            End If
            'Protection in case the value is out of min and max range
            If cCell.Offset(0, 2).Value > .Object.Max Then
                cCell.Offset(0, 2).Value = .Object.Max
            ElseIf cCell.Offset(0, 2).Value < .Object.Min Then
                cCell.Offset(0, 2).Value = .Object.Min
            End If
            Target.Value = cCell.Offset(0, 3).Value + (cCell.Offset(0, 5).Value * cCell.Offset(0, 2).Value)
            .Object.Value = cCell.Offset(0, 2).Value
            .LinkedCell = "Param!" & cCell.Offset(0, 2).Address 'setting up linked cell
        End With
        ' Setting up the position and width of scrollbar with reference to the cell
        shScroll.Top = Target.Top
        shScroll.Left = Target.Offset(0, 1).Left + 2 'position to the right + small margin
        shScroll.Width = Target.Offset(0, 5).Left - Target.Offset(0, 1).Left - 2 'width of 5 columns
        shScroll.Visible = True
    End If

    Set actSheet = Nothing
    Set shScroll = Nothing
    Set cCell = Nothing
End Sub

Private Function SearchAdr(SheetFly As String, kom As String, rng As Range) As Range
Dim cCell As Range
Dim oOOo As Name

' Searching for the row with parameter for chosen cell
' The parameter have to be in one, continouse range

For Each cCell In rng
    If cCell.Text = "" Then ' check if parameters have not finished
        Set SearchAdr = Nothing
        Exit Function ' stop if you find first empty cell for speeding
    ElseIf Left(cCell.Text, 1) = "$" Then ' normal address
        If cCell.Offset(0, 1).Text & "!" & UCase(cCell.Text) = SheetFly & "!" & UCase(kom) Then
            Set SearchAdr = cCell
            Exit Function   ' exit if find proper row with parameters
        End If
    Else ' means that found is a name
        For Each oOOo In ActiveWorkbook.Names
            If (oOOo.RefersTo = "=" & SheetFly & "!" & UCase(kom)) And (UCase(oOOo.Name) = UCase(cCell.Text)) Then
                Set SearchAdr = cCell
                Exit Function   ' exit if find proper row with parameters
            End If
        Next oOOo
    End If
Next cCell

End Function

In your workbook you have to make sheet named Param where the parameters of scrollbar are stored. In column A and C put the name of your sheet where you want scrollbars to appear. The sheet looks like this:

Now you can enjoy the scrollbar after clicking the cell in the model sheet.

Note that you can define different min, max ranges and step of scrollbar change separately for every cell. Moreover, the min and max range can be negative.

My solution is simple however I wished it could be further improved with respect to speed. With complex calculations within the workbook the performance of scrollbar might be better.