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

[Cuzzaa]

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.

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

 

[Kamolga]

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]

How about

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

 

[Cuzzaa]

Thanks both! They're perfect! Much appreciated for your help

 

[Fluff]

Glad we could help & thanks for the feedback