Yet more filters...

[pgarcia]

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 didn’t lose.

 

[Tom Ogilvy]

Dim r as Range, r1 as Range
set r = Range("H1").Currentregion
set r = Intersect(r.EntireRow,Columns("H"))
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

 

[pgarcia]

Awesome!! Thanks

I do have another question. Say the user opens a different spread sheet and
it has one extra column. Is a way to have an input box asking from what to
what columns you need to hi-lit?

 

[Tom Ogilvy]

You can have the user select the range with a mouse

Dim rr as Range
set rr = Nothing
On Error Resume next
set rr = Application.InputBox("Select columns with mouse",type:=8)
On Error goto 0
if rr is nothing then
msgbox "Nothing selected"
exit sub
else
msgbox rr.Address
end if

Note that Application.Inputbox is the Excel inputbox. just Inputbox is the
VBA inputbox.

 

[pgarcia]

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("C13550").AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:= _
Range("R13:R19"), Unique:=False

Set r = Range("H1").CurrentRegion
Set r = Intersect(r.EntireRow, Columns("H"))
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]

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("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
Unique:=False

Set r = Range("H1").CurrentRegion
Set r = Intersect(r.EntireRow, Columns("H"))
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

 

[pgarcia]

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]

as demonstrated in the immediate window:

set r = Range("A1:M200")
Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1)
? r.address
$A$2:$M$200


that line worked fine for me.

 

[Tom Ogilvy]

I assume you don't have data all the way to the very bottom of the worksheet.
If r had an address like

Range("H165536")

then you would get an error. Put in a message box like this


Set r = Range("H1").CurrentRegion
Set r = Intersect(r.EntireRow, Columns("H"))
msgbox r.Address
set r = r.offset(1,0).Resize(r.rows.count-1)

 

[Tom Ogilvy]

Or if you don't have any data in H1 and around H1.

I assumed you Headers for your data were/are in row 1. If that is a bad
assumption, then you will need adjust H1 to the upper row of your data.

 

[pgarcia]

That's the ticket. Thanks for the help

as demonstrated in the immediate window:

set r = Range("A1:M200")
Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1)
? r.address
$A$2:$M$200


that line worked fine for me.

 

[pgarcia]

Sub A_Intl_Increase()
'By Paul Garcia & Tom Ogilvy

Application.ScreenUpdating = False
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("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
Unique:=False

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "CLO"
Range("S13").Select
ActiveCell.FormulaR1C1 = ".15"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents
Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "LIM"
Range("S13").Select
ActiveCell.FormulaR1C1 = ".50"

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

Set r = Range("H13500")
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

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "AUS"
Range("R15").Select
ActiveCell.FormulaR1C1 = "GRU"
Range("R16").Select
ActiveCell.FormulaR1C1 = "MAO"
Range("R17").Select
ActiveCell.FormulaR1C1 = "RIO"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.10"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "MVD"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.25"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "VCP"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.35"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "CWB"
Range("R15").Select
ActiveCell.FormulaR1C1 = "POA"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.5"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

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

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("A1").Select
MsgBox ("The update is now complete.")
End Sub
Tom, one last thing. What is the VB code to un-Hi-lit the cells? I'm running
the following and need to un-Hi-lit the cells. Thanks

 

[pgarcia]

Sorry about that, how to un Hi-lit the cells? This is the code I'm running.
(a let mess, but I'll tide up later).
Thanks

Sub A_Intl_Increase()
'By Paul Garcia & Tom Ogilvy

Application.ScreenUpdating = False
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("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
Unique:=False

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "CLO"
Range("S13").Select
ActiveCell.FormulaR1C1 = ".15"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents
Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "LIM"
Range("S13").Select
ActiveCell.FormulaR1C1 = ".50"

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

Set r = Range("H13500")
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

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "AUS"
Range("R15").Select
ActiveCell.FormulaR1C1 = "GRU"
Range("R16").Select
ActiveCell.FormulaR1C1 = "MAO"
Range("R17").Select
ActiveCell.FormulaR1C1 = "RIO"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.10"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "MVD"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.25"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "VCP"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.35"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "CWB"
Range("R15").Select
ActiveCell.FormulaR1C1 = "POA"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.5"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

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

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("A1").Select
MsgBox ("The update is now complete.")
End Sub

 

[pgarcia]

Tom, sorry to bother you again, but I fond the problem. When using Advanced
Filter, the filter list or selection I was not change the range. Looks like
the range should be the same size as the list. I just had it set at
Range("R13:R19") when it should have been modified to the size of the list.
Please see VB code below. Thanks for the help.

Sub A_Intl_Increase()
'By Paul Garcia & Tom Ogilvy

Application.ScreenUpdating = False
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("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
Unique:=False

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "CLO"
Range("S13").Select
ActiveCell.FormulaR1C1 = ".15"

Range("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R14"), _
Unique:=False

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "LIM"
Range("S13").Select
ActiveCell.FormulaR1C1 = ".50"

Range("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R14"), _
Unique:=False

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "AUS"
Range("R15").Select
ActiveCell.FormulaR1C1 = "GRU"
Range("R16").Select
ActiveCell.FormulaR1C1 = "MAO"
Range("R17").Select
ActiveCell.FormulaR1C1 = "RIO"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.10"

Range("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R17"), _
Unique:=False

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "MVD"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.25"

Range("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R14"), _
Unique:=False

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "VCP"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.35"

Range("C13550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R14"), _
Unique:=False

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

Range("R13").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("R14").Select
ActiveCell.FormulaR1C1 = "CWB"
Range("R15").Select
ActiveCell.FormulaR1C1 = "POA"
Range("S13").Select
ActiveCell.FormulaR1C1 = "1.5"

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

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

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

Set r = Range("H13500")
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

With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Range("R:S").ClearContents

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow + 1 & ":" & .Rows.Count).Delete
End With

Range("A1").Select
MsgBox ("The update is now complete.")
End Sub