Copying filtered data

[Guest]

What I am trying to do is display filtered comments from a worksheet in a
list box on a form. Once I have applied a filter to a sheet of data the code
below starts. The code works except it shows me all comments. I only want to
see the filtered or Visible comments. How do I step through the filtered
comments? or is there a diffrent way I could go about this?

sub getcomments()
ActiveCell.CurrentRegion.Select
R = Selection.CurrentRegion.Columns(1).SpecialCells(xlVisible).Count
Range("K2").Select
Load CommentForm
num = 1
Do Until ActiveCell.Row > R
CommentForm.ListBox1.AddItem (num & ") " & ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
num = num + 1
Loop
If num = 1 Then
CommentForm.ListBox1.AddItem ("No comments")
Else
End If
CommentForm.Show
end sub 'getcomments

 

[Sharad Naik]

One Way, without much changin your code:
In the Do Loop you can change as under:

Do Until ActiveCell.Row > R
If Not ActiveCell.EntireRow.Hidden Then
CommentForm.ListBox1.AddItem (num & ") " & ActiveCell.Value)
num = num + 1
End If
ActiveCell.Offset(1, 0).Select
Loop

Note: the num = num + 1 has to be moved up inside If, End If to get correct
cout
of visible cells.

Sharad

 

[Tom Ogilvy]

sub getcomments()
ActiveCell.CurrentRegion.Select
set rng = Selection.CurrentRegion.SpecialCells(xlVisible)
set rng = Intersection(rng.EntireRow,Columns(11))
R = rng.Count

Load CommentForm
num = 1
for each cell in rng
CommentForm.ListBox1.AddItem (num & ") " & Cell.Value)
num = num + 1
Next
If Num = 1 Then
CommentForm.ListBox1.AddItem ("No comments")
Else
End If
CommentForm.Show
end sub 'getcomments

 

[Guest]

This one worked except I Had to change the R =
Selection.CurrentRegion.Columns(1).SpecialCells(xlVisible).Count to R=
Range("A65536").End(xlUp).Rows

Awsome job thanks.

 

[Guest]

This is cool. I really like how this one works. Named ranges has lots of
possibilities. The only problem is that it picks up the first row of data
which are headings. Anyway around this without hiding the first row?

Just incase someone esle wants to use this code. the intercetion should be
interect.

 

[Tom Ogilvy]

You mean Intersection should be intersect - my mental lapse.

sub getcomments()
ActiveCell.CurrentRegion.Select
set rng = Selection.CurrentRegion.SpecialCells(xlVisible)
set rng = Intersect(rng.EntireRow,Columns(11))
R = rng.Count

Load CommentForm
num = 1
for each cell in rng
if num <> 1 then
CommentForm.ListBox1.AddItem (num & ") " & Cell.Value)
End if
num = num + 1
Next
If Num = 1 Then
CommentForm.ListBox1.AddItem ("No comments")
Else
End If
CommentForm.Show
end sub 'getcomments

Would be one way.

I often remove the first row from the range, but then if you do
specialcells, you can get an error if there are no visible rows. Therefore
it would be

Dim rng as Range, rng1 as Range
ActiveCell.CurrentRegion.Select
set rng = Selection.CurrentRegion
set rng = rng.offset(1,0).Resize(rng.rows.count - 1)
On Error resume Next
set rng1 = rng.SpecialCells(xlVisible)
On Error goto 0
if not rng1 is nothing then
set rng = Intersect(rng1.EntireRow,Columns(11))
else
msgbox "no visible rows"
exit sub
end if

' continue on