Filtering a database then copying visible cells based on CurrentRe

[Guest]

Good morning all,

I'm using VBA loop to repeatedly filter a database based on the contents of
a list of cells containing employee names.
Once I filter on a particular name, I end up with (say) a header row and
5-10 rows of data underneath.
I then want to copy the data rows (but not the header row) into another
workbook.
I've been trying to use CurrentRegion, then offsetting this selection by 1
and resizing by the number of rows in the currentselection minus 1 to exclude
the header rows and select the data rows thus:

Set EFCR = Range("A4").CurrentRegion
EFCR.Offset(1, 0).Resize(EFCR.Rows.Count - 1, EFCR.Columns.Count).Copy

The problem I have is that Currentregion includes all the hidden date rows
that have been excluded by the filter, so I can't use it to select my data.
There may be only 10 rows visible, but Currentregion returns the size of the
whole database.

I think I need some combination of CurrentRegion and xlCellTypeVisible to
accomplish what I need, but I'm not sure if this is possible, or, if it is,
what the syntax should be. Otherwise, the alternative is a very nasty
For-Next loop for every crow in the database. Ugly.

Can anyone help, please?

Thanks in advance

Pete

 

[Norman Jones]

Hi Peter,

Try something like:


Set Rng1 = ActiveSheet.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)

If Not rng2 Is Nothing Then
rng2.Copy Destination:= _
Sheets("Your Destination Sheet Name").Range("A2")
End If

 

[Guest]

Norman,

This almost works. What I'm trying to do is, for any given list of staff
members (found in the "consolidating" worksheet), to read a workbook that
contains (by staff member) daily bookings per project at one booking per
project per day per row, so each person might have between 0 and many rows in
any given week), and bring them into the consolidating workbook.

If rows are displayed for the staff member when the database is filtered,
the correct rows are copied over. If no rows are displayed, then the whole of
the database is copied over. I'm stumped - any suggestions?

Pete

P.S. Here's my code with your mods added:

Sub ConsolidateSAPDataLoop()

SetFolderName
ChDir FolderName
CombFileName = FolderName & "SMP " & Format(Year, "00") & WeekNumber &
".xls"
If Dir(CombFileName) = "" Then
MsgBox (CombFileName & " does not exist")
Exit Sub
End If

Set DropDownSheet = Worksheets("DropDowns")
Set DropDownResourceNames = DropDownSheet.Range("DropDownResourceNames")

Workbooks.Open Filename:=CombFileName
CombFileWindowName = ActiveWorkbook.Name

Sheets("All Staff").Activate
Range("A4").Select
Selection.RemoveSubtotal
Selection.CurrentRegion.Select
Dim SeekRange As Range
Dim SeekCell As Range
Set SeekRange = Selection.Offset(1, 1).Resize(Selection.Rows.Count - 1, 1)

For Each ResourceName In DropDownResourceNames
ConsolidatingLabel.Value = "Consolidating: " & ResourceName.Value &
" - please wait"
Selection.AutoFilter Field:=2, Criteria1:=ResourceName
Set Rng1 = ActiveSheet.AutoFilter.Range
Set Rng2 = Rng1.Offset(1, 0).Resize(Rng1.Rows.Count - 1, 5)
If Not Rng2 Is Nothing Then
Rng2.Copy
Windows(ConsolidatorWorkBookName).Activate 'return to
consolidator
DefineDatabase
If DBCR.Rows.Count = 1 Then 'i.e. if no data rows, select the
row below DBHeader
DBStart.Offset(1, 0).Select
Else 'select the first empty row beneath existing data
DBStart.Offset(DBCR.Rows.Count).Select
End If
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Windows(CombFileWindowName).Activate 'activate the file that has
just been consolidated
End If
Next
ConsolidatingLabel.Value = "Consolidation complete!"
ActiveWorkbook.Close 'Close it and return to Consolidator
DBStart.Offset(1, 0).Select
Application.CutCopyMode = False
End Sub

 

[Norman Jones]

Hi Peter,

Some questions:

You set a range SeekRange rather oddly. Could you describe in words the
geography of this range. Also, having set the SeekRange, you do not appear
to use it?

Do I undestand that your intention is to copy all filtered rows from the All
Staff sheet to the Consolidator sheet: and, if there is no filtered data you
want to copy the the entire database (minus headings) to the consolidator
sheet?

From your code it would appear that you only want to copy columns 1 to 5
from the database. Is that correct?

 

[Guest]

Good morning, Norman.

I DID reply to you yesterday, but the posting's not here for some reason.

I managed to solve the problem (in a not tremendously neat way, I must admit)

I was able to select the headers plus the filtered data, which I then
repeatedly copied to my "consolidator" workbook. This left me with a lot of
instances of "<Header><Data>, so, when I'd brought all the data in, I did a
simple For Next loop on the first column of the database, deleting all rows
where the cell contents were equal to "WorkDate" (this being the field header
for this particular column)

If I tried to select an offset of the database headers, based on the number
of visible filtered rows (which I WAS able to identify), the resulting
selection was that number of rows, not that number of VISIBLE rows.

At least it's faster than doing a nested loop on each cell of the database
being brought in!

Anyway, thanks for your interest and advice - you certainly started me off
in the right direction.

Have a good weekend

Pete