I do some filtering on a range and copy that filtered range with
myRange.SpecialCells(xlCellTypeVisible).Copy
As soon as the filter filters all cases I get
Error 1004 No cells were found
I am looking for a way to check (without an On Error) if the filtered range is empty.
I already tried to set a range with lastRow = .Cells(.Rows.Count, ColumnName).End(xlUp).Row and check if lastRow > 0 but with this way I also count the filtered (or hidden) row contents.
I also tried
Sub test()
Dim rngStart As Range
Dim rngFiltered As Range
Set rngStart = Sheets(1).Range("A1:A6")
Set rngFiltered = rngStart.SpecialCells(xlCellTypeVisible).Select
If rngFiltered.Rows.Count = 0 Then
MsgBox ("No Cases")
Else
MsgBox ("Found Cases")
End If
End Sub
But here I get the error "No cells found" in the Set rngFiltered line as well.
I have no header row, since the filter is so complex that I programmed it without using the .Sort function
Dim rngStart As Range
Dim rngFiltered As Range
'...
'...
Set rngFiltered = Nothing '<<< reset rngFiltered if running this code in a loop...
On Error Resume Next
Set rngFiltered = rngStart.SpecialCells(xlCellTypeVisible)
On Error Goto 0
If not rngFiltered is Nothing then
rngFiltered.Copy
End If
'...
'...
I stored the solution into a function. Here I use an error on mechamism.
Function errorCatchEmptyFilter(ByRef rngstart As Range) As Boolean
errorCatchEmptyFilter = False
'here I get an error if there are no cells
On Error GoTo hell
Set rngFiltered = rngstart.SpecialCells(xlCellTypeVisible)
Exit function
hell:
errorCatchEmptyFilter = True
End Function
What I do is I am counting filtered rows :
Sheets("Sheet1").Range("A2:Z2").AutoFilter
Sheets("Sheet1").Range("A2:Z2").AutoFilter Field:=1, Criteria1:=filter1
If Sheets("Sheet1").AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Count > 1 Then
you can change number of column to suits your needs
Got the same problem, but for filtering named table, solved it this way*:
instead of applying several filters, I've added a column at the end of the table, with a formula that would return true for the rows I wanted to have filtered in, false for filtered out.
Then, I've applied one filter for that true value and added a cell that would count all true values in that column
in vba, firstly reapply filter for the table then if that counter is greater than 0 do .SpecialCells(xlCellTypeVisible).Copy, else skip to next step (i was doing that in a loop)
*I know that this question is from 2015, but I've ended here in 2019 googling similar problem so I'm leaving my solution.
Related
---Update---
Thanks for the responses, I have found that DragonSamu's updated answer works perfectly.
---Original Post---
I have been trying to figure out where I am going wrong for the past few hours but I can't spot it. I think it's because the script is trying to draw the value from the active worksheet which is not what I want. Hopefully somebody can put me on the rite track - I think the answer should be relatively obvious but I just can't see it!
Basically, I am trying to populate a Combobox with a dynamic range of values that exist in another worksheet (but in the same workbook). I can get the Combobox to populate when I run the script in the worksheet 'Materials' (which is where the dynamic list is drawn from) but not when I run it in the worksheet 'Products'.
Unfortunately the script is designed to populate Products with Materials so is be run in a UserForm when the 'Products' worksheet is open and the 'Materials' worksheet would therefore be inactive.
I should also note that this script has been adapted from code I found elsewhere on this forum, so if it seems familiar I thank you in advance :)
Private Sub UserForm_Initialize()
Dim rRange As Range
On Error GoTo ErrorHandle
'We set our range = the cell B7 in Materials
Set rRange = Worksheets("Materials").Range("B7")
'Check if the cell is empty
If Len(rRange.Formula) = 0 Then
MsgBox "The list is empty"
GoTo BeforeExit
End If
'Finds the next empty row and expands rRange
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
'The range's address is our rowsource
Mat1_Name_ComBox.RowSource = rRange.Address
Mat2_Name_ComBox.RowSource = rRange.Address
Mat3_Name_ComBox.RowSource = rRange.Address
Mat4_Name_ComBox.RowSource = rRange.Address
Mat5_Name_ComBox.RowSource = rRange.Address
BeforeExit:
Set rRange = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description
Resume BeforeExit
End Sub
Any help is much appreciated.
Cheers,
Simon
From what I can see your code would be giving an error here:
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
Because your trying to set rRange by using Range() without defining the Worksheet first. This will get the Range from the ActiveWorksheet.
change it to the following:
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Worksheets("Materials").Range(rRange, rRange.End(xlDown))
End If
best practice would be the following:
Private Sub UserForm_Initialize()
Dim wb as Workbook
Dim sh as Worksheet
Dim rRange As Range
On Error GoTo ErrorHandle
'Set the Workbook and Worksheet
set wb = Workbooks("products.xlsx")
set sh = wb.Worksheets("Materials")
'We set our range = the cell B7 in Materials
Set rRange = sh.Range("B7")
'Check if the cell is empty
If Len(rRange.Formula) = 0 Then
MsgBox "The list is empty"
GoTo BeforeExit
End If
'Finds the next empty row and expands rRange
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = sh.Range(rRange, rRange.End(xlDown))
End If
By properly defining and setting your Workbook and Worksheet you correctly reference to them and don't get errors.
Update:
the 2nd problem is that rRange.Address only places the Range location inside your .RowSource not the Sheet it needs to look at.
change:
Mat1_Name_ComBox.RowSource = rRange.Address
to:
dim strSheet as String
strSheet = "Materials"
Mat1_Name_ComBox.RowSource = strSheet + "!" + rRange.Address
This way it will include the Sheet name into the .RowSource
I'm using the following code in an attempt to detect a filter applied to a column in a table and then clear the filter:
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
According to Microsoft documentation:
This property is true if the worksheet contains a filtered list in which there are hidden rows.
This doesn't seem to be the case since ActiveSheet.Filtermode only returns True if a cell inside the table where the filter is applied is selected.
First question: Is the documentation wrong? Documentation
Second question: Is my only option to select a cell inside the table to get the expression to return True?
PS I am using Excel 2010
Edit: Answer to Question 2, Non-select based methods to clear filters...
If ActiveSheet.ListObjects(1).Autofilter.FilterMode Then ActiveSheet.ListObjects(1).Autofilter.Showalldata
I can replicate both your issues on Excel 2013: both the buggy False on FilterMode and the error on ShowAllData.
In response to whether the documentation is wrong, I would say that it is missing a qualification to say that the ActiveCell should be in the ListObjects DataBodyRange. Perhaps the documentation is correct but that this is a bug that has not been addressed. Maybe you can update your question with a link to the documentation?
Re your second question - I agree that using this workaround is the most obvious solution. It seems a bit unpleasant to use Select but sometimes I guess this cannot be avoided.
This is how I did it using the Intersect function to check it the ActiveCell is currently in the area of the DataBodyRange of the ListObject:
Option Explicit
Sub Test()
Dim rng As Range
Dim ws As Worksheet
Dim lst As ListObject
'get ActiveCell reference
Set rng = ActiveCell
'get reference to Worksheet based on ActiveCell
Set ws = rng.Parent
'is there a Listobject on the ActiveCells sheet?
If ws.ListObjects.Count > 0 Then
Set lst = ws.ListObjects(1)
Else
Debug.Print "No table found"
Exit Sub
End If
'is cell is in the DataBodyRange of ListObject?
If Intersect(rng, lst.DataBodyRange) Is Nothing Then
'set the ActiveCell to be in the DataBodyRange
lst.DataBodyRange.Cells(1, 1).Select
End If
'now you can safely call ShowAllData
If ws.FilterMode = True Then
ws.ShowAllData
End If
End Sub
Edit
Further to #orson's comment:
What happens if you skip the If Intersect(rng, lst.DataBodyRange) Is Nothing Then and use If lst.AutoFilter.FilterMode Then lst.AutoFilter.ShowAllData End If ?
So, you can check the FilterMode of the ListObject itself and then as long as you have a reference to the ListObject you can use his code:
If lst.AutoFilter.FilterMode Then
lst.AutoFilter.ShowAllData
End If
An easier alternative can be to just AutoFit all rows:
Rows.AutoFit
The issue with that is that it will un-hide and auto fit all rows on the active sheet.
Update from http://www.contextures.com/excelautofilterlist.html
Dim list As ListObject
For Each list ActiveSheet.ListObjects
If list.AutoFilter.FilterMode Then
list.AutoFilter.ShowAllData
End If
Next
i have designed a few codes to help remove reference errors however it does not automatically delete until i assign the macro to a button. i do not want it that way as it would seem unpleasant when i want to present the programme to my team members, and having to remove the errors on the spot with a button. I thought of combining my delete cells code and remove reference cell codes together so that they would run simultaneously but to no avail. Is it possible to combine these two codes to achieve my objective or are there any solutions or coding to remove/hide reference errors automatically? Here are the two codes. All of your help would be very much appreciated!
Sub deletetry2()
Dim R As Range
Set rng = Nothing
On Error Resume Next
Set R = Application.InputBox("Select cells To be deleted", Type:=8)
If TypeName(R) <> "Range" Then
Exit Sub
Else
R.Delete
End If
End Sub
Sub Check_ReferenceDeletecolumn()
Dim rng As Range
Dim rngError As Range
Set rng = Sheets("Sheet3").Range("A1:G100")
On Error Resume Next
Set rngError = rng.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If Not rngError Is Nothing Then
rngError.EntireColumn.Delete
'delete means cells will move up after deleting that entire row
End If
End Sub
If the objective is to remove all rows containing errors, from a user defined range, this should work:
Option Explicit
Public Sub cleanUserDefinedRange()
Dim response As Range
On Error Resume Next
Set response = Application.InputBox("Select range to clean up errors", Type:=8)
If Not response Is Nothing Then cleanUpErrors response
On Error GoTo 0
End Sub
'------------------------------------------------------------------------------------------
Private Sub cleanUpErrors(ByRef rng As Range)
Application.ScreenUpdating = False
rng.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
In Excel 2007, I am looping through the values of column 4 in Sheet 2. Still in Sheet 2, I want to output the result of my vlookup formula into column 5. The vlookup formula needs to refer to Sheet 1 where the reference columns are. In order to do so I have the following formula
Range("E2") = Application.WorksheetFunction.VLookup(Range("D2"), _
Worksheets("Sheet1").Range("A1:C65536"), 1, False)
Problem, it returns error code 1004. I read that it was because I needed to Select Sheet 1 before running the formulas such as:
ThisWorkbook.Worksheets("Sheet1").Select
But then the searched value Range ("D2") doesn't belong to Sheet 1 and it still return code 1004 after having brought Sheet 1 into view.
What is the correct way to refer to a different sheet in this case?
try this:
Dim ws as Worksheet
Set ws = Thisworkbook.Sheets("Sheet2")
With ws
.Range("E2").Formula = "=VLOOKUP(D2,Sheet1!$A:$C,1,0)"
End With
End Sub
This just the simplified version of what you want.
No need to use Application if you will just output the answer in the Range("E2").
If you want to stick with your logic, declare the variables.
See below for example.
Sub Test()
Dim rng As Range
Dim ws1, ws2 As Worksheet
Dim MyStringVar1 As String
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set rng = ws2.Range("D2")
With ws2
On Error Resume Next 'add this because if value is not found, vlookup fails, you get 1004
MyStringVar1 = Application.WorksheetFunction.VLookup(rng, ws1.Range("A1:C65536").Value, 1, False)
On Error GoTo 0
If MyStringVar1 = "" Then MsgBox "Item not found" Else MsgBox MyStringVar1
End With
End Sub
Hope this get's you started.
The answer your question: the correct way to refer to a different sheet is by appropriately qualifying each Range you use.
Please read this explanation and its conclusion, which I guess will give essential information.
The error you are getting is likely due to the sought-for value Sheet2!D2 not being found in the searched range Sheet1!A1:A65536. This may stem from two cases:
The value is actually not present (pointed out by chris nielsen).
You are searching the wrong Range. If the ActiveSheet is Sheet1, then using Range("D2") without qualifying it will be searching for Sheet1!D2, and it will throw the same error even if the sought-for value is present in the correct Range.
Code accounting for this (and items below) follows:
Sub srch()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim srchres As Variant
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
On Error Resume Next
srchres = Application.WorksheetFunction.VLookup(ws2.Range("D2"), ws1.Range("A1:C65536"), 1, False)
On Error GoTo 0
If (IsEmpty(srchres)) Then
ws2.Range("E2").Formula = CVErr(xlErrNA) ' Use whatever you want
Else
ws2.Range("E2").Value = srchres
End If
End Sub
I will point out a few additional notable points:
Catching the error as done by chris nielsen is a good practice, probably mandatory if using Application.WorksheetFunction.VLookup (although it will not suitably handle case 2 above).
This catching is actually performed by the function VLOOKUP as entered in a cell (and, if the sought-for value is not found, the result of the error is presented as #N/A in the result). That is why the first soluton by L42 does not need any extra error handling (it is taken care by =VLOOKUP...).
Using =VLOOKUP... is fundamentally different from Application.WorksheetFunction.VLookup: the first leaves a formula, whose result may change if the cells referenced change; the second writes a fixed value.
Both solutions by L42 qualify Ranges suitably.
You are searching the first column of the range, and returning the value in that same column. Other functions are available for that (although yours works fine).
Your code work fine, provided the value in Sheet2!D2 exists in Sheet1!A:A. If it does not then error 1004 is raised.
To handle this case, try
Sub Demo()
Dim MyStringVar1 As Variant
On Error Resume Next
MyStringVar1 = Application.WorksheetFunction.VLookup(Range("D2"), _
Worksheets("Sheet1").Range("A:C"), 1, False)
On Error GoTo 0
If IsEmpty(MyStringVar1) Then
MsgBox "Value not found!"
End If
Range("E2") = MyStringVar1
End Sub
It's been many functions, macros and objects since I posted this question. The way I handled it, which is mentioned in one of the answers here, is by creating a string function that handles the errors that get generate by the vlookup function, and returns either nothing or the vlookup result if any.
Function fsVlookup(ByVal pSearch As Range, ByVal pMatrix As Range, ByVal pMatColNum As Integer) As String
Dim s As String
On Error Resume Next
s = Application.WorksheetFunction.VLookup(pSearch, pMatrix, pMatColNum, False)
If IsError(s) Then
fsVlookup = ""
Else
fsVlookup = s
End If
End Function
One could argue about the position of the error handling or by shortening this code, but it works in all cases for me, and as they say, "if it ain't broke, don't try and fix it".
This code makes Excel non-responsive. Anyone know why that might be?
Sub delblank()
On Error Resume Next
ActiveSheet.UsedRange.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
If Err Then
MsgBox "No blank cells"
End If
End Sub
The problem is that UsedRange won't accept Range("A:A") as a property because the used range in your sheet does not contain an entire column from top to bottom of the Excel sheet, i.e. from row 1 to row 1048756.
What you want instead is to refer to the first column of UsedRange: replace Range("A:A") by Columns(1) like this:
ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Now it works.
When you have a long chain of methods and properties giving you trouble like that, it's easier to break it down into its constituents in order to find the source of the error. That's what I did:
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim sh As Worksheet
Set sh = ActiveSheet
Set r1 = sh.UsedRange
Set r2 = r1.Range("A:A") ' Aha, error occurs here! Wow, that was easy to find.
Set r3 = r1.SpecialCells(xlCellTypeBlanks)
r3.EntireRow.Delete
When the error is gone, it's fine to put the chain back together again to get rid of the clutter.
Also don't use On Error Resume Next unless you're absolutely certain that this is what you want, because it will just swallow errors and not tell you where they came from.
Try something like this:
Public Sub Tester()
On Error Resume Next
Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
Try below code
Sub delblank()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng As Range
On Error Resume Next
Set rng = ActiveSheet.UsedRange.Range("A:A").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "No cells found"
Else
rng.EntireRow.Delete
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub