Copying Down Cells after Unique Filter

J

Jon C

Hi, I'm trying to build a spreadsheet, in VBA, based on timesheet data. I'd
like a total of time spent on each task. The task list can change so the
first job is to define all unique tasks. I've used the following:



Sheets("Detail").Columns("E:E").AdvancedFilter Action:=xlFilterCopy, _

CopyToRange:=Range("A1"), Unique:=True



Works fine. The problem comes when I try and automatically copy down the
formulas I want to use on each row against each task description. I started
with this:



Dim lLastRow As Long



lLastRow = Sheets("Monthly
Summary").Cells.SpecialCells(xlCellTypeLastCell).Row



Debug.Print "lLastRow = " & lLastRow



Worksheets("Monthly Summary").Activate

Range("B2:N2").Select



Selection.AutoFill Destination:=Sheets("Monthly Summary").Range("B2:N" &
lLastRow - 1), Type:=xlFillDefault



The problem I face is that on my destination sheet I can only 'see' thirty
or so tasks but lLastRow reports 440 with nothing 'visible' in cells 31 to
440! Hence, my copy down goes on way beyond where I need it to finish.



Any suggestions please?



Thanks,



Jon C



p.s. I know pivots would be an ideal approach but there are downstream
limitations to using them here.
 
J

Jim Thomlinson

It is a little hard to tell exactly what you want but in a nut shell you want
to do stuff with the visible cells? How about using something similar to

Dim rng As Range
Set rng = Sheet1.Range("A1:A100").SpecialCells(xlCellTypeVisible)

if rng is nothing then
'No visible cells so do nithing....
endif

the range object is no only the visible cells and you can use it to do that
voodoo that you do...

HTH
 
T

Tom Ogilvy

Try this modification:

With Sheets("Detail")
set rng = .Range(.Cells(1,"E"),.Cells(rows.count,"E").End(xlup))
End With
rng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Monthly Summary") _
.Range("A1"), Unique:=True

if that is still problematic (and it may be, I recall some problem like this
with advanced filter) then try


Dim lLastRow As Long
lLastRow = 1
With Sheets("Monthly Summary")
do while trim( .cells(lLastRow + 1,1).Text) <> ""
lLastRow = lLastRow + 1
Loop
End With
Debug.Print "lLastRow = " & lLastRow
Worksheets("Monthly Summary").Activate
Range("B2:N2").Select
Selection.AutoFill Destination:=Sheets( _
"Monthly Summary").Range("B2:N" & _
lLastRow - 1), Type:=xlFillDefault
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top