Top 25 in a filtered list

[John Wilson]

I'm sure this has been answered before but I can't seem to
find it in the archives.

I'm looking to copy the top 25 visible rows on a filtered list.

Actually, to be specific......
Header row is 5
With the list filtered, I'm looking to copy only the first 25 visible
rows from Columns "C" through "H"

Thanks,
John

[John Wilson]

Found it.

Thanks Bernie

"John Wilson" <[email protected]> wrote in message
news:%23Zc5O%[email protected]...
> I'm sure this has been answered before but I can't seem to
> find it in the archives.
>
> I'm looking to copy the top 25 visible rows on a filtered list.
>
> Actually, to be specific......
> Header row is 5
> With the list filtered, I'm looking to copy only the first 25 visible
> rows from Columns "C" through "H"
>
> Thanks,
> John
>

[Tom Ogilvy]

Assuming that you are not showing the top 25 - there are probably more than
25 rows visible then:

dim rng as Range, cell as Range
Dim rng1 as Range, rng2 as Range
set rng = ActiveSheet.AutoFilter.Range
set rng = rng.offset(1,0).Resize(rng.rows.count-1).Columns(1)
for each cell in rng
if cell.entirerow.Hidden = False then
if rng1 is nothing then
set rng1 = cell
else
set rng1 = union(rng,cell)
end if
end if
if rng1.count = 25 then exit for
Next
if not rng1 is nothing then
set rng2 = Intersect(rng1.EntireRow,Columns("C:H")
rng2.copy Destination:=Worksheets("Data1").Range("A2")
End if


--
Regards,
Tom Ogilvy


"John Wilson" <[email protected]> wrote in message
news:%23Zc5O%[email protected]...
> I'm sure this has been answered before but I can't seem to
> find it in the archives.
>
> I'm looking to copy the top 25 visible rows on a filtered list.
>
> Actually, to be specific......
> Header row is 5
> With the list filtered, I'm looking to copy only the first 25 visible
> rows from Columns "C" through "H"
>
> Thanks,
> John
>
>

[John Wilson]

Tom,

That worked too.

Thank you

What I found earlier from Bernie Deitrick was the following:

Dim myR As Range
Dim iRow As Integer
iRow = 25
Set myR = Range(Cells(6, 1), Cells(Rows.Count, 1).End(xlUp))
MsgBox "Visible row " & iRow & " is actual row " & _
GetVisibleRow(myR, iRow) & "."
Range(Range("C6"), Range("H" & LastVR)).Copy
Worksheets("top25Query").Activate
Range("B31").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Function GetVisibleRow(myRange As Range, i As Integer) As Variant
Dim j As Integer
Dim myCell As Range
Set myRange = myRange.Offset(1, 0).Resize(myRange.Rows.Count - 1, 1)
j = 0
For Each myCell In myRange.SpecialCells(xlCellTypeVisible)
j = j + 1
If j = i Then
GetVisibleRow = myCell.Row
LastVR = myCell.Row
Exit Function
End If
Next
GetVisibleRow = "Not enough visible rows to return row " & i & "."
End Function


"Tom Ogilvy" <[email protected]> wrote in message
news:%[email protected]...
> Assuming that you are not showing the top 25 - there are probably more
> than
> 25 rows visible then:
>
> dim rng as Range, cell as Range
> Dim rng1 as Range, rng2 as Range
> set rng = ActiveSheet.AutoFilter.Range
> set rng = rng.offset(1,0).Resize(rng.rows.count-1).Columns(1)
> for each cell in rng
> if cell.entirerow.Hidden = False then
> if rng1 is nothing then
> set rng1 = cell
> else
> set rng1 = union(rng,cell)
> end if
> end if
> if rng1.count = 25 then exit for
> Next
> if not rng1 is nothing then
> set rng2 = Intersect(rng1.EntireRow,Columns("C:H")
> rng2.copy Destination:=Worksheets("Data1").Range("A2")
> End if
>
>
> --
> Regards,
> Tom Ogilvy
>
>
> "John Wilson" <[email protected]> wrote in message
> news:%23Zc5O%[email protected]...
>> I'm sure this has been answered before but I can't seem to
>> find it in the archives.
>>
>> I'm looking to copy the top 25 visible rows on a filtered list.
>>
>> Actually, to be specific......
>> Header row is 5
>> With the list filtered, I'm looking to copy only the first 25 visible
>> rows from Columns "C" through "H"
>>
>> Thanks,
>> John
>>
>>
>
>