PC Review


Reply
Thread Tools Rate Thread

Copy after autofilter if range is not empty

 
 
=?Utf-8?B?dGlnZ2Vy?=
Guest
Posts: n/a
 
      14th Nov 2007
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
 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Copy range if column N is empty ajm1949 Microsoft Excel Programming 24 13th May 2010 05:00 AM
Copy range from Sheet1 into empty range in Sheet2 Buddy Microsoft Excel Programming 1 19th Aug 2009 12:07 AM
AutoFilter Cut/Copy not working with Name Range NoodNutt Microsoft Excel Worksheet Functions 2 6th Sep 2008 11:37 PM
Copy data to next empty row in a range ward376 Microsoft Excel Programming 2 10th Mar 2008 05:23 AM
autofilter copy to new range =?Utf-8?B?TW9uaXF1ZQ==?= Microsoft Excel Programming 3 19th Jul 2005 09:39 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 05:07 AM.