I would like to increase the speed of changing the value of an Excel cell with just the mouse. I share my instrument in the hope that someone will like it and they want to improve it.
This is an example. After clicking on a specific cell containing a value, a scroll bar is displayed on the right side of the cell. You can smoothly change its value with the mouse.
The tool is designed to change the value of cells and dynamically monitor the values of formulas. You can simplify the code, however some features should not be disabled. It should always remain dynamic, that is, moving the scrollbar should immediately affect other cells using formulas. The scroll bar should not flicker (changing the color to gray and black).
You can simply download the scrollbar.xlsm file here and view the VBA code inside it.
Or you can put this code on your sheet where you want scollbars to appear. The name of your sheet does not matter. Right-click on the sheet name and select View Code . This place:
Paste this code here:
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 AG are used, othre columns can be used for something else ' Do not change the layout of AG columns unless you want to modify the code ' Addresses in Param have to be with dollars (ie $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 ie 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, SearchCell 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(SearchCell) 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(SearchCell)) 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 book, you should make a worksheet named Param , where the scrollbar options are stored. In columns A and C, indicate the name of your sheet in which you want the scroll bars to appear. The sheet is as follows:
Now you can enjoy the scroll bar after clicking a cell in the model sheet.
Please note that you can define different min, max intervals and the step for changing the scroll bar separately for each cell. Moreover, the range of min and max may be negative.