T
tigger
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
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