Vba help needed please - change range of values by x number

Cuzzaa

Board Regular
Joined
Apr 30, 2019
Messages
86
Hi Everyone

I really hope someone can help.

I am trying to use the code below to use a button to help simply change the values of a range of cells by a specific number, please can someone help amend the below code for me so that the user doesn't have to select a range of cells but the range is set to 'H5:H500' instead? Is there also a way so that if the user enters -100 then the values are all decreased by 100 instead of adding 100? Thanks so much in advance to anyone that can help.

VBA Code:
Sub AddNumberPrompt()
Dim ws As Worksheet
Dim rngSel As Range
Dim rng As Range
Dim Num As Double
Dim i As Long
Dim j As Long
Dim lAreas As Long
Dim lRows As Long
Dim lCols As Long
Dim Arr() As Variant
Dim strPrompt As String
Set rngSel = Selection
lAreas = rng.Areas.Count
strPrompt = "Enter number to add to selected cells"

On Error Resume Next
Num = InputBox(strPrompt, "Number to Add", 7)

If Num <> 0 Then
  For Each rng In rngSel.Areas
     If rng.Count = 1 Then
        rng = rng + Num
     Else
        lRows = rng.Rows.Count
        lCols = rng.Columns.Count
        Arr = rng
        For i = 1 To lRows
           For j = 1 To lCols
              Arr(i, j) = Arr(i, j) + Num
           Next j
        Next i
        rng.Value = Arr
     End If
  Next rng
End If

End Sub
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Kamolga

Well-known Member
Joined
Jan 28, 2015
Messages
1,176
VBA Code:
Sub AddNumberPrompt()
Dim ws As Worksheet
Dim rngSel As Range
Dim rng As Range
Dim Num As Long
Dim i As Long
Dim j As Long
Dim lAreas As Long
Dim lRows As Long
Dim lCols As Long
Dim Arr() As Variant
Dim strPrompt As String
Set rngSel = Range("H5:H500")
strPrompt = "Enter number to add to H5:500"

On Error Resume Next
Num = InputBox(strPrompt, "Number to add", 7)

If Num <> 0 Then
  For Each rng In rngSel.Areas
     If rng.Count = 1 Then
        rng = rng + Num
     Else
        lRows = rng.Rows.Count
        lCols = rng.Columns.Count
        Arr = rng
        For i = 1 To lRows
           For j = 1 To lCols
              Arr(i, j) = Arr(i, j) + Num
           Next j
        Next i
        rng.Value = Arr
     End If
  Next rng
End If

End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,653
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub cuzzaa()
   Dim Num As Variant
   
   Num = InputBox("Enter number to add to selected cells", "Number to Add", 7)
   If Num = "" Or Not IsNumeric(Num) Then Exit Sub
   With Range("H5:H500")
      .Value = Evaluate(Replace("if(@="""","""",@+" & Num & ")", "@", .Address))
   End With
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,653
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,118,294
Messages
5,571,379
Members
412,385
Latest member
OChambo94
Top