MSG if no data in AutoFilter

[gob12345]

Hi All,

My AutoFilter works providing there is data to be copied but I get an error if there is no data. I have tried to bypass the process if there is no data and show a "No data" msgbox but I can't get it to work. I have tried solutions from previous threads but for some reason I am still getting the same error when there is no data.
Any help will be appreciated.

Regards

Gob12345

'check the dates if all is OK run the filter
 If Sheet1.Range("D3").Value >= Sheet1.Range("E3").Value Then
 MsgBox " Your start value is wrong"
 Exit Sub
 Else
 If Not IsEmpty(dDateTimeBegin) And Not IsEmpty(dDateTimeEnd) Then
 'run the filter
 With Rng
 .AutoFilter Field:=2, Criteria1:=">=" & dDateTimeBegin, _
 Operator:=xlAnd, Criteria2:="<=" & dDateTimeEnd
'If there is data then proceed, otherwise show msgbox
If Sheet2.Range("Database").SpecialCells(xlCellTypeVisible).Count > 1 Then 'THIS HIGHLIGHTS YELLOW IN DEBUG WHEN THERE IS NO DATA
 'copy values
 CopyFilter
 'show all data
 Showall
 Else
    MsgBox "No Data in Selected Range"
 End If
 End With

 

[Kaper]

But you filter range Rng and then check for xlcelltypevisible presence in other range

 Sheet2.Range("Database")

so may be the second range is longer rhen Rng (or may be it contains also top row of the autofilter - then of course this row is visible

 

[Fluff]

Hi & welcome to MrExcel
How about

   With rng
      .autofilter Field:=2, Criteria1:=">=" & dDateTimeBegin, _
         Operator:=xlAnd, Criteria2:="<=" & dDateTimeEnd
      On Error Resume Next
      r = rng.Offset(1).Resize(rng.Rows.Count - 1).SpecialCells(xlVisible).Count
      On Error GoTo 0
      If r = 0 Then MsgBox "No data": Exit Sub
      'copy values
      CopyFilter
      'show all data
      Showall
   End With

The SpecialCells will return an error if there are no cells that match. And AFAIK the only way to deal with that is with error handling

 

[gob12345]

Hi Kaper and Fluff,

Thank you both for the responses.

Kaper - Good point! Rng included the title row and Database didn't, I corrected this to match them but it hasn't solved the error.

Fluff - I tried your code but it brings up the MsgBox everytime

I did however make the most of On Error Resume Next which means the code now works but doesn't bring up a MsgBox.

This is actually fine for the system requirements but the msgbox would still be a nice extra (and it's bugging me that it doesn't work) So any further assistance would be appreciated.

Here is the up to date code including subroutines for context

Sub Showall()
'show all filtered data and remove filter
    With Sheet2
        If Sheet2.AutoFilterMode Then
            Sheet2.Range("C6").AutoFilter
        End If
    End With
End Sub

Sub CopyFilter()




'clear the contents
    Sheet1.Range("D7:U10000").ClearContents
'copy and paste the range
    Sheet2.Range("Database").SpecialCells(xlCellTypeVisible).Copy _
    Destination:=Sheet1.Range("D7")
    
  '  Else
   '             MsgBox "No data in selected range"
'End If
End Sub

Sub Between2DateTimes()


'Set all "Filter" Cells the same
Sheet3.Range("B5").Value = Sheet1.Range("D3").Value
Sheet3.Range("C5").Value = Sheet1.Range("E3").Value


 Dim Rng As Range
 Dim strDate As String
Dim dDateBegin As Date, dTimeBegin As Date
Dim lDateBegin As Long, dblTimeBegin As Double
Dim dDateTimeBegin As Double
Dim rDateBegin As Range, rTimeBegin As Range


Dim dDateEnd As Date, dTimeEnd As Date
Dim lDateEnd As Long, dblTimeEnd As Double
Dim dDateTimeEnd As Double
Dim rDateEnd As Range, rTimeEnd As Range


Set Rng = Sheet2.Range("C6")
Set rDateBegin = Sheet1.Range("D3") 'Cell housing Begin date & time
Set rDateEnd = Sheet1.Range("E3") 'Cell housing End date & time


    dDateBegin = DateSerial(Year(rDateBegin), Month(rDateBegin), Day(rDateBegin))
    lDateBegin = dDateBegin
    Set rTimeBegin = rDateBegin
    dTimeBegin = TimeSerial(Hour(rTimeBegin), Minute(rTimeBegin), Second(rTimeBegin))
    dblTimeBegin = dTimeBegin
    dDateTimeBegin = lDateBegin + dblTimeBegin
    
    dDateEnd = DateSerial(Year(rDateEnd), Month(rDateEnd), Day(rDateEnd))
    lDateEnd = dDateEnd
    Set rTimeEnd = rDateEnd
    dTimeEnd = TimeSerial(Hour(rTimeEnd), Minute(rTimeEnd), Second(rTimeEnd))
    dblTimeEnd = dTimeEnd
    dDateTimeEnd = lDateEnd + dblTimeEnd
    
    
'check the dates if all is OK run the filter
 If Sheet1.Range("D3").Value >= Sheet1.Range("E3").Value Then
 MsgBox " Your start value is wrong"
 Exit Sub
 Else
 If Not IsEmpty(dDateTimeBegin) And Not IsEmpty(dDateTimeEnd) Then
 'run the filter
 With Rng
 .AutoFilter Field:=2, Criteria1:=">=" & dDateTimeBegin, _
 Operator:=xlAnd, Criteria2:="<=" & dDateTimeEnd
'If there is data then proceed, otherwise show msgbox
'On Error Resume Next
      On Error Resume Next


 'copy values
 CopyFilter
 'show all data
 Showall
 
 End With
 End If
 End If
  RefreshAllPivotTables
  
 Sheet3.Range("A:U").EntireColumn.AutoFit
 
 'error block
 On Error GoTo 0
 Exit Sub
 
 
errHandler:
 MsgBox "There is no data"
 Showall
 Sheet1.Select


End Sub