Create a Macro to ask and question, and then update cells

[hbarnett]

I would like to create a macro that ask a question, question I am looking to ask is Please enter percent
Once the user enters in a percent say 25
I would then like it to update a range of cells that already have information in them

So for example I have these rows which has a unit price in them.

When the user enters 25, it will change the 1st row to 1.25, the second row to 2.50 etc.

Unit Price
$1.00
$2.00
$3.00
$4.00
$5.00
$6.00
$7.00
$8.00
$9.00
$10.00

 

[JLGWhiz]

Yes it had a word missing, try this version.

Sub t3()
Dim nr As Long, pct As Double, fn As Range, c As Range
nr = Application.InputBox("Please enter a percentage as a whole number, e.g. 25", "PERCENTAGE", Type:=1)
pct = nr / 100
With ActiveSheet
    Set fn = .Rows(3).Find("Unit Price", , xlValues)
        If Not fn Is Nothing Then
            For Each c In fn.Offset(1).Resize(10)
                If c.Value > 0 Then
                    c = c.Value + (c.Value * pct)
                End If
            Next
        End If
End With
End Sub

 

[hbarnett]

Thank you so much, you are a god among man.

I really appreciate all of your help

 

[JLGWhiz]

Thank you so much, you are a god among man.

I really appreciate all of your help

You're welcome,
Regards, JLG

 

[hbarnett]

Good Morning,

One more question is it possible after the user puts in the quantity and it makes the change on the spreadsheet, that it pops up with another box to say Accept Change Yes/No

And if the users selects No it undoes the change and reverts back to the original number?

 

[JLGWhiz]

Sub t4()
Dim nr As Long, pct As Double, fn As Range, c As Range, rval As Variant
nr = Application.InputBox("Please enter a percentage as a whole number, e.g. 25", "PERCENTAGE", Type:=1)
pct = nr / 100
With ActiveSheet
    Set fn = .Rows(3).Find("Unit Price", , xlValues)
        rval = fn.Offset(1).Resize(10).Value
        If Not fn Is Nothing Then
            For Each c In fn.Offset(1).Resize(10)
                If c.Value > 0 Then
                    c = c.Value + (c.Value * pct)
                End If
            Next
        End If
        q = MsgBox("Accept changes?", vbQuestion + vbYesNo, "VALIDATE")
        If q = vbNo Then fn.Offset(1).Resize(10) = rval
End With
End Sub