Hi Menucha,

I was asked this same problem a little while ago and this is the result.

This code will do what you want except it is 15% not 5% - it should be easy to change.

The beauty of it is that it leaves the original values present and changes them into a formula which multiplies them by 1.15 - 1.05 in your case. Also it ignores text formulas, SUM formulas and SUBTOTAL formulas. Just highlight the area you want to change and run the macro. I set up a toolbar button for my user who would be using it frequently.

Sub Apply115()

'

' Apply115 Macro

' Macro recorded 13/11/2002 by Peter J Moran

' Increments Selected Cells or Column(s) by 1.15 (115%)

' Note: SUM formulae excluded from function to avoid double incrementing

' Modified 27/11/02 with additional checks and options

'

Dim oCell As Range

Application.ScreenUpdating = False

Application.Calculation = xlManual

Dim oSelect As Range

If TypeName(Selection) <> "Range" Then GoTo Finish

Set oSelect = Intersect(Selection, ActiveSheet.UsedRange)

For Each oCell In oSelect

If Left(oCell.Formula, 1) = "=" Then

If IsNumeric(oCell) Then

If Left(oCell.Formula, 5) <> "=SUM(" Then

If Left(oCell.Formula, 6) <> "=(SUM(" Then

If Left(oCell.Formula, 10) <> "=SUBTOTAL(" Then

If Left(oCell.Formula, 11) <> "=(SUBTOTAL(" Then

oCell.Formula = "=(" & _

Right(oCell.Formula, _

Len(oCell.Formula) - 1) & ") * 1.15"

End If

End If

End If

End If

End If

Else

If oCell.Value <> "" Then

If IsNumeric(oCell) Then

oCell.Formula = "=(" & oCell.Value & ") * 1.15"

End If

End If

End If

Next

Finish:

Application.ScreenUpdating = True

Application.Calculation = xlAutomatic

End Sub

Good Luck!

Peter Moran