Thanks, but it error out on line:

Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1)

(it's in Office 2k, if that helps)

"Tom Ogilvy" wrote:

Sub A_Intl_Increase()
'By Paul Garcia

Dim r As Range, r1 As Range
With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With
Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "BOG"
Range("R15").Select
ActiveCell.FormulaR1C1 = "BUE"
Range("R16").Select
ActiveCell.FormulaR1C1 = "EZE"
Range("R17").Select
ActiveCell.FormulaR1C1 = "SCL"
Range("R18").Select
ActiveCell.FormulaR1C1 = "UIO"
Range("R19").Select
ActiveCell.FormulaR1C1 = "VLN"
Range("S13").Select
ActiveCell.FormulaR1C1 = ".10"

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

Set r = Range("H1").CurrentRegion
Set r = Intersect(r.EntireRow, Columns("H:P"))
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:=xlAdd, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End if
ActiveSheet.ShowAllData

Range("R:S").ClearContents

End Sub

--
Regards,
Tom Ogilvy

"pgarcia" wrote:

I ran into a problem. After I have hi-lit the cells, I need to copy, paste,
value+add cell S13. It un-hi-lits the cells. How can I get around this. Thanks

Sub A_Intl_Increase()
'By Paul Garcia

Dim r As Range, r1 As Range
With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With
Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "BOG"
Range("R15").Select
ActiveCell.FormulaR1C1 = "BUE"
Range("R16").Select
ActiveCell.FormulaR1C1 = "EZE"
Range("R17").Select
ActiveCell.FormulaR1C1 = "SCL"
Range("R18").Select
ActiveCell.FormulaR1C1 = "UIO"
Range("R19").Select
ActiveCell.FormulaR1C1 = "VLN"
Range("S13").Select
ActiveCell.FormulaR1C1 = ".10"

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

Set r = Range("H1").CurrentRegion
Set r = Intersect(r.EntireRow, Columns("H:P"))
On Error Resume Next
Set r1 = r.SpecialCells(xlVisible)
On Error GoTo 0
If Not r1 Is Nothing Then
' place holder command process r1 here
r1.Select
End If

Range("S13").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.ShowAllData

Range("R:S").ClearContents

End Sub


"Tom Ogilvy" wrote:

Dim r as Range, r1 as Range
set r = Range("H1").Currentregion
set r = Intersect(r.EntireRow,Columns("H:P"))
On Error Resume Next
set r1 = r.specialcells(xlvisible)
On Error goto 0
if not r1 is nothing then
' place holder command process r1 here
r1.Select
End if

--
Regards,
Tom Ogilvy



"pgarcia" wrote:

Ok, I'm using the Advanced Filter to filter a list. Works great, no problems.
Now however, I need to increase the dollar amount in columns H-P. Manually I
can just copy the amount, say $.10, hi-lit the selected cells and do a Paste
Special, Values + Add and the will increase the dollar amount. The problem
is, I have different criteria for the filter list and different dollar
amounts. Again, no problem, I can run a VB code to change the list and
amounts, but how can I use a VB code to single out just the filtered cells in
columns H-P so that I can update them? Hope I didnt lose.