View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
tigger tigger is offline
external usenet poster
 
Posts: 17
Default Copy after autofilter if range is not empty

Hi there,

I'm using a function to filter data on other sheets and summarise them on a
separate sheet. The function works great until it comes across a range with
no data except the column headings - it then copies the column headings
instead of ignoring the range.

Any ideas how I can force it to ignore an "empty" range?

Thanks - code below

Private Sub cmdGetData_Click() 'Get all open findings

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Lrow As Long
Dim First As Long
Dim Last As Long
Dim shLast As Long
Dim rng As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set DestSh = ThisWorkbook.Worksheets("Summary")

'delete all existing data
With DestSh
.DisplayPageBreaks = False
StartRow = 12
EndRow = LastRow(DestSh)
For Lrow = EndRow To StartRow Step -1
.Rows(Lrow).Delete
Next
End With

'loop through all worksheets and copy the data to Summary
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then

sh.AutoFilterMode = False 'Remove existing AutoFilter

sh.Range("A1").AutoFilter Field:=7, Criteria1:="Open" 'Filter by
"Open" findings
'Need a function to ignore if range is null ...

Last = LastRow(DestSh)
shLast = LastRow(sh)

'Copy range and paste into Summary as values
With sh.Range("D2:H2", sh.Cells(sh.Rows.Count,
"D").End(xlUp)).SpecialCells(xlCellTypeVisible )
DestSh.Cells(Last + 1, "B").Resize(.Rows.Count,
..Columns.Count).Value = .Value
End With

'Copy sheet name to Summary column A
DestSh.Cells(Last + 1, "A").Value = sh.Name

sh.AutoFilterMode = False 'Remove AutoFilter
End If
Next

With DestSh
.DisplayPageBreaks = False
.Range("G12:G" & Range("B65536").End(xlUp).Row).FormulaR1C1 = _
"=IF(ISBLANK(RC[-5]),"""",IF((RC[-3]-RC[-4])5,
""Red"",IF(AND((RC[-3]-RC[-4])1," & _
"(RC[-3]-RC[-4])<5),""Amber"",""Green"")))"
End With

Application.GoTo DestSh.Cells(1)

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub