Changing Cell Value Code

[tomsweddy]

Hi,

I need some code that does the following on a button press or macro run command;

1. Looks in the range J12:J30 (where there are some cells containing percentage figures in the format XX%), finds the percentage from that cell and multiplies it by a monetary value in cell J9. Therefore it replaces each cell in the J12:J30 range with a new monetary figure (so maybe the format of the cell would need to change too?).

2. Some cells in the range are blank so it would do nothing in this case....

Please tell me if this can be done. The reason i need this code is that I have over 500 sheets to do and doing this manually will take forever!!

Tom

[mdmackillop]

Sub Macro1()
Range("J9").Copy
Range("J12:J30").PasteSpecial Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("J12:J30").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("J:J").EntireColumn.AutoFit
Range("J9").Select
Application.CutCopyMode = False
End Sub

[tomsweddy]

Thanks for your answer great!

I tried to replicate your code for two other similar functions however this does not work correctly...

Could you advise how I would add the other subs into your original so it could all be done at once?

Thanks

Sub Wizard1()
Range("J9").Copy
Range("J12:J30").PasteSpecial Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("J12:J30").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("J:J").EntireColumn.AutoFit
Range("J9").Select
Application.CutCopyMode = False
End Sub
Sub Wizard2()
Range("K9").Copy
Range("K12:K30").PasteSpecial Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("K12:K30").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("K:K").EntireColumn.AutoFit
Range("K9").Select
Application.CutCopyMode = False
End Sub
Sub Wizard3()
Range("L9").Copy
Range("L12:L30").PasteSpecial Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("L12:L30").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("L:L").EntireColumn.AutoFit
Range("L9").Select
Application.CutCopyMode = False
End Sub

[mdmackillop]

Option Explicit
'One at a time for separate ranges
Sub Wizard1()
Call Wizard(Range("J9"), Range("J12:J30"))
Call Wizard(Range("K9"), Range("K12:K30"))
Call Wizard(Range("L9"), Range("L12:L30"))
End Sub
'All at once for Block of ranges
Sub Wizard2()
Call Wizard(Range("J9:L9"), Range("J12:L30"))
End Sub

Sub Wizard(Cash As Range, PerCent As Range)
Cash.Copy
PerCent.PasteSpecial Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
PerCent.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns(Cash.Column).EntireColumn.AutoFit
Cash.Select
Application.CutCopyMode = False
End Sub