Input Box to update multiple sheets/cells

DanielkPOL

New Member
Joined
Nov 5, 2019
Messages
2
Hey ya'll,

Been tinkering a bit to see if I could get the macro recorded/cobbled together to do the following, and I keep hitting roadblocks in debug:

1.) Select several Sheets, and Ranges in each
2.) Have an Input box pop up, requesting a number
3.) Increasing the selected sheets/ranges by that number as a percentage increase

i.e. Click the ActiveX button (CommandInput), Sheets 1 and 2, Range B1:B8 selected, ask for input number, type 5, all selected cells increase by 5%

This will scale eventually as the various sheets get built, I've been experimenting with a single sheet and small number of cells to get a base code written while the main book is being worked by someone else.

TIA
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,684
Office Version
2007
Platform
Windows
In the Array line you can select the sheets.
Run the macro and select a range of cells that contain numerical values.

Code:
Sub Update_sheets()
  Dim rng As Variant, c As Range, shs As Variant, i As Long, num As Double
  On Error Resume Next
  Set rng = Application.InputBox("Select cells", Default:=Selection.Address, Type:=8)
  If rng Is Nothing Then Exit Sub
  On Error GoTo 0
  num = Application.InputBox(prompt:="Enter number", Type:=1)
  If num = 0 Then Exit Sub
  shs = Array("Sheet10", "Sheet11")
  For i = 0 To UBound(shs)
    For Each c In rng
      Sheets(shs(i)).Range(c.Address).Value = Sheets(shs(i)).Range(c.Address).Value * (1 + (num / 100))
    Next
  Next
End Sub
 

DanielkPOL

New Member
Joined
Nov 5, 2019
Messages
2
Thank you so much, this is a great foundation for me to tinker with! As I play with the options I'll update here.

So far the only adder I've put in is a Worksheet Activate

Code:
Sub CommandButton1_Click()
Worksheets("Sheet1").Activate
Dim rng As Variant, c As Range, shs As Variant, i As Long, num As Double
  On Error Resume Next
  Set rng = Application.InputBox("Select cells", Default:=Selection.Address, Type:=8)
  If rng Is Nothing Then Exit Sub
  On Error GoTo 0
  num = Application.InputBox(prompt:="Enter number", Type:=1)
  If num = 0 Then Exit Sub
  shs = Array("Sheet1")
  For i = 0 To UBound(shs)
    For Each c In rng
      Sheets(shs(i)).Range(c.Address).Value = Sheets(shs(i)).Range(c.Address).Value * (1 + (num / 100))
    Next
  Next
  Worksheets("Sheet1").Activate
End Sub
 

Forum statistics

Threads
1,085,545
Messages
5,384,371
Members
401,890
Latest member
Angela7

Some videos you may like

This Week's Hot Topics

Top