Catching "no cells were found"

[jose luis]

Hi All,

Could anyone guide me to detect when, after an autofilter search (usin
a UserForm), the criteria1 results in "no cells".

Let me try to explain me better. I have two sheets, in sheet1 I have
"ListBox1" wich updates after the sheet2, wich contains a table, i
modified with Autofilter operations made with a UserForm that run
from Sheet1 with a click button.

My problems araise when the criteria used doesn't generate visibl
cells, at the moment of updating sheet1, generates an error that say
"No cells were found".

This is the code (Provided by Dave and others in this forum) in sheet
to update the ListBox1


Code
-------------------
Private Sub Worksheet_Activate()

Dim wks As Worksheet
Dim rng As Range
Dim rngF As Range
Dim myCell As Range
Dim iCtr As Long

Sheets("Historia").ScrollArea = "A1:N45"

'Worksheets("BDHistoria").Visible = True
'Worksheets("BDHistoria").Select

Set wks = Worksheets("BDHistoria")

If Sheets("BDHistoria").EnableAutoFilter = True Then
'Deja como esta
Else:
Worksheets("BDHistoria").Range("A3").AutoFilter VisibleDropDown:=True
End If

Set rng = wks.AutoFilter.Range


With rng
Set rngF = .Resize(.Rows.Count - 1, 1).Offset(1, 0).Cells.SpecialCells(xlCellTypeVisible)
End With

With Sheets("Historia").ListBox1
.ListFillRange = ""
.Clear
.ColumnCount = rng.Columns.Count
For Each myCell In rngF.Cells
.AddItem (myCell.Text)
For iCtr = 1 To rng.Columns.Count - 1
.List(.ListCount - 1, iCtr) = myCell.Offset(0, iCtr).Text
Next iCtr
Next myCell
End With
1:
Sheets("Historia").Select
End Su
-------------------



The line where the macro breaks in error is this:


Code
-------------------
Set rngF = .Resize(.Rows.Count - 1, 1).Offset(1, 0).Cells.SpecialCell
-------------------


Hope the explanation was a bit more clear .

Thanks in advance for your guidance.


Saludos

Jose Lui

 

[Dave Peterson]

One way:

Set rng = wks.AutoFilter.Range

if rng.columns(1).cells.specialcells(xlcelltypevisible).cells.count = 1 then
'only the header is visible
else
'you have details showing
end if

Another way:

set rngF = nothing
on error resume next
With rng
Set rngF = .Resize(.Rows.Count - 1, 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With
on error goto 0

if rngf is nothing then
'no details.
else
'got details
end if

 

[jose luis]

Thank a lot Dave,

your suggestion was just what i need, thanks again!!.

Hoping not to abuse of your time, Could you give me a hint on how t
increase the number of columns in the ListBox. I used the code you sen
me:


Code
-------------------
Set rng = wks.AutoFilter.Range

With rng
Set rngF = .Resize(.Rows.Count - 1, 1).Offset(1, 0).Cells.SpecialCells(xlCellTypeVisible)
End With

With Sheets("Historia").ListBox1
.ListFillRange = ""
.Clear
.ColumnCount = rng.Columns.Count
For Each myCell In rngF.Cells
.AddItem (myCell.Text)
For iCtr = 1 To rng.Columns.Count - 1
.List(.ListCount - 1, iCtr) = myCell.Offset(0, iCtr).Text
Next iCtr
Next myCell
End With
1:
Sheets("Historia").Select
End Su

-------------------


But when I increase the number of columns with AutoFilter (instead o
selecting 8 columns, i want to display 11 columns. The code works fin
with less than 10 columns inclusive, but when i set 11 columns the cod
breaks in this line:



Code
-------------------
For iCtr = 1 To rng.Columns.Count - 1
.List(.ListCount - 1, iCtr) = myCell.Offset(0, iCtr).Text
Next iCt
-------------------


I discovered that for unbound list the limit is 10 columns, so in orde
to show more columns the listbox needs to be Bound, but that conditio
is contrary to the solution already suplied.

Could you give me a hand with this?

Thanks again

Best Regards

Jose Lui

 

[Dave Peterson]

The bad news is that you can't exceed 10 columns when you add items that way.

You could take the filter range, copy it to a temporary worksheet and then use
that range as the listfillrange and have more columns.

This seemed to work ok for me:

Option Explicit
Private Sub Worksheet_Activate()

Dim wks As Worksheet
Dim rng As Range
Dim rngF As Range
Dim myCell As Range
Dim iCtr As Long
Dim tempWks As Worksheet
Dim VisibleRows As Long

Sheets("Historia").ScrollArea = "A1:N45"

Set wks = Worksheets("BDHistoria")

' If Sheets("BDHistoria").EnableAutoFilter = True Then
' 'Deja como esta
' Else
' Worksheets("BDHistoria").Range("A3").AutoFilter VisibleDropDown:=True
' End If

Set rng = wks.AutoFilter.Range
VisibleRows = rng.Columns(1).Cells _
.SpecialCells(xlCellTypeVisible).Cells.Count - 1

If VisibleRows = 0 Then
Exit Sub
End If

With rng
Set rngF = .Resize(.Rows.Count - 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With

Set tempWks = Worksheets.Add
rngF.Copy _
Destination:=tempWks.Range("a1")

With Worksheets("Historia").ListBox1
.Clear
.ListFillRange = ""
.ColumnCount = rng.Columns.Count
.List = tempWks.Range("a1") _
.Resize(VisibleRows, rngF.Columns.Count).Value
End With

Application.EnableEvents = False
Sheets("Historia").Select
Application.EnableEvents = True

Application.DisplayAlerts = False
tempWks.Delete
Application.DisplayAlerts = True

End Sub

I wasn't sure if Historia was the worksheet that owns the code. If it is, then
I'd change:

Worksheets("Historia").
to
Me.

Me is the thing that owns the code--in this case the worksheet "Historia".

(In all those spots.)