Hello all,
I have this bit of code and I need to add the following fomula instead of
the VB code. Thanks

I need this part changed:
r1.PasteSpecial Paste:=xlValues, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

To some thing like this: =ROUND(ROUND(A1,2)*1.09,2)

End With

Range("R:S").ClearContents

Range("R13").Select
ActiveCell.FormulaR1C1 = "COUNTRY"
Range("R14").Select
ActiveCell.FormulaR1C1 = " New Zealand"
Range("R15").Select
ActiveCell.FormulaR1C1 = "Australia"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.9"

Range("A13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R15"), _
Unique:=False

Set r = Range("H13:P500")
Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1)

On Error Resume Next
Set r1 = r.SpecialCells(xlVisible)
On Error GoTo 0
If Not r1 Is Nothing Then
Range("S13").Copy
r1.PasteSpecial Paste:=xlValues, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If

pgarcia,

Change

If Not r1 Is Nothing Then
Range("S13").Copy
r1.PasteSpecial Paste:=xlValues, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If

to, for example:

If Not r1 Is Nothing Then
r1.Formula = "=ROUND(ROUND($A" & R1.Cells(1,1).Row & ",2)*1.09,2)"
End If

If you want each formula to refer to column A of its own row....

HTH,
Bernie
MS Excel MVP


"pgarcia" wrote in message
...
Hello all,
I have this bit of code and I need to add the following fomula instead of
the VB code. Thanks

I need this part changed:
r1.PasteSpecial Paste:=xlValues, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

To some thing like this: =ROUND(ROUND(A1,2)*1.09,2)

End With

Range("R:S").ClearContents

Range("R13").Select
ActiveCell.FormulaR1C1 = "COUNTRY"
Range("R14").Select
ActiveCell.FormulaR1C1 = " New Zealand"
Range("R15").Select
ActiveCell.FormulaR1C1 = "Australia"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.9"

Range("A13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R15"), _
Unique:=False

Set r = Range("H13:P500")
Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1)

On Error Resume Next
Set r1 = r.SpecialCells(xlVisible)
On Error GoTo 0
If Not r1 Is Nothing Then
Range("S13").Copy
r1.PasteSpecial Paste:=xlValues, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If