ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Yet more filters... (https://www.excelbanter.com/excel-programming/413846-yet-more-filters.html)

pgarcia
Yet more filters...
 
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.

Tom Ogilvy
Yet more filters...
 
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.

pgarcia
Yet more filters...
 
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" 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.

Tom Ogilvy
Yet more filters...
 
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.
--
Regards,
Tom Ogilvy



"pgarcia" wrote:

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" 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.

pgarcia
Yet more filters...
 
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.

Tom Ogilvy
Yet more filters...
 
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.

pgarcia
Yet more filters...
 
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.

Tom Ogilvy
Yet more filters...
 
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.

--
Regards,
Tom Ogilvy



"pgarcia" wrote:

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.

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

Range("H1:P65536")

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:P"))
msgbox r.Address
set r = r.offset(1,0).Resize(r.rows.count-1)


--
Regards,
Tom Ogilvy


"pgarcia" wrote:

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.

Tom Ogilvy
Yet more filters...
 
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.

--
Regards,
Tom Ogilvy


"pgarcia" wrote:

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.

pgarcia
Yet more filters...
 
That's the ticket. Thanks for the help

"Tom Ogilvy" wrote:

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.

--
Regards,
Tom Ogilvy



"pgarcia" wrote:

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.

pgarcia
Yet more filters...
 
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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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

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

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

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

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

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


"Tom Ogilvy" wrote:

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.

--
Regards,
Tom Ogilvy


"pgarcia" wrote:

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.

pgarcia
Yet more filters...
 
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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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

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

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

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

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

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 Ogilvy" wrote:

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.

--
Regards,
Tom Ogilvy


"pgarcia" wrote:

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.

pgarcia
Yet more filters...
 
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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R19"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R14"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R14"), _
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:=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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R17"), _
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

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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R14"), _
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

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("C13:P550").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("R13:R14"), _
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

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("C13: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

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("C13: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

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 Ogilvy" wrote:

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.

--
Regards,
Tom Ogilvy


"pgarcia" wrote:

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.


All times are GMT +1. The time now is 05:09 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com