Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Yet more filters...
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 304
Default 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.
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default 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.
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 304
Default 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.
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default 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.
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 304
Default 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.
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default 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.
Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 304
Default 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.
Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default 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.
Reply With QuoteReply With Quote
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default 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.
Reply With QuoteReply With Quote
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default 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.
Reply With QuoteReply With Quote
  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 304
Default 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.
Reply With QuoteReply With Quote
  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 304
Default 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.
Reply With QuoteReply With Quote
  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 304
Default 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.
Reply With QuoteReply With Quote
  #14   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 304
Default 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.
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Can I use "OR" in two auto-filters/custom filters? Roady Excel Discussion (Misc queries) 1 May 24th 10 06:11 PM
Pivot Table filters, especially DATE filters chris Excel Worksheet Functions 0 August 27th 08 04:33 AM
Filters Probber Excel Worksheet Functions 3 January 9th 07 04:51 PM
How to copy with filters but not copy the filters in the middle? ztalove Excel Discussion (Misc queries) 0 November 1st 06 04:53 PM
Filters, Subtotal & Intacted Results after the filters' Removal kasiopi Excel Discussion (Misc queries) 5 February 24th 06 12:18 PM


All times are GMT +1. The time now is 10:31 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement