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]

Sub t()
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(1).Find("Unit Price", , xlValues)
        If Not fn Is Nothing Then
            For Each c In Intersect(.UsedRange.Offset(1), Columns(fn.Column))
                If c.Value > 0 Then
                    c = c.Value + (c.Value * pct)
                End If
            Next
        End If
End With
End Sub

 

[hbarnett]

JLGWhiz - thank you for you help, I am getting an error on the c=c.value + (c.value *pct) part though.

Here is a screen shot of the file I am working on. I change the .rows(1) to .row(3) as there is where the unit price is

 

[JLGWhiz]

What is the error message?

 

[JLGWhiz]

If the error is type mismatch, it is likely because the Intersect function is not valid with the headers bing in row 3. The code below should fix that.

Sub t()
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 Intersect(.UsedRange.Offset(3), Columns(fn.Column))
                If c.Value > 0 Then
                    c = c.Value + (c.Value * pct)
                End If
            Next
        End If
End With
End Sub

 

[hbarnett]

We are close, we are getting the run time error when it column 14, as that column says Grand Total

So I only need it do columns 4 through 13

 

[JLGWhiz]

i assume you mean rows 4:13.

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 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]

I get a run time error mismatch

 

[JLGWhiz]

Try the code in post #7.

 

[hbarnett]

I get a compile, syntax error