I have a large Excel sheet and to that I have added a dynamic search field textbox and that works fine.
Private Sub TextBox1_Change()
ActiveSheet.Range("E6:E150").AutoFilter Field:=4, Criteria1:="*" & [G1000] & "*", Operator:=xlFilterValues
End Sub
The problem is that if I filter out say row number 500 the result is not visible so I have to manually move the cursor up.
I tried this (and a lot of other stuff) without success.
Private Sub TextBox1_Change()
With ActiveSheet.Range("E6:E150").AutoFilter Field:=4, Criteria1:="*" & [G1000] & "*", Operator:=xlFilterValues
.Select
End With
End Sub
It yield this
"run-time error '424': Object required"
Any help is appreciated.
Perhaps the first visible cell above the currently selected but hidden activecell.
Private Sub TextBox1_Change()
with ActiveSheet
.Range("E6:E150").AutoFilter Field:=1, Criteria1:="*" & [G1000] & "*"
if activecell.EntireRow.hidden then
dim i as long
for i=activecell.row to 6 step-1
if not .cells(i, activecell.column).EntireRow.hidden then
.cells(i, activecell.column).select
exit for
end if
next i
end if
end with
End Sub
I've changed the AutoFilter field to 1 as there aren't 4 fields in Range("E6:E150"); there is only 1. Also removed the unnecessary Operator:=xlFilterValues as that is only required when using an array as Criteria1.
Sorry for being unprecise.
Using select is no good idea I can see from implementing Jeepeds answer.
I found what I'm after:
Private Sub TextBox1_Change()
With ActiveSheet
.Range("E6:E150").AutoFilter Field:=4, Criteria1:="" & [G1000] & ""
ActiveWindow.ScrollRow = 1
End With
End Sub
Just that simple.
Related
I want to stop my loop if the current selection is empty. I have tried the following:
If (IsEmpty(Sheets("Sheet3").ActiveCell)) Then Exit Do
If Sheets("Sheet3").Selection.Value = "" Then Exit Do ;tried to replace "" with Empty and Nothing but didn't work either
If Sheets("Sheet3").Activecell.Value is Empty Then Exit Do
If Sheets("Sheet3").Selection is blank Then Exit Do
The issue is if I don't stop the loop somehow it will carry on forever.
I was hoping somebody can help me here.
EDIT :
This is my code:
Public Sub CopyFilteredData()
Do
Sheets("Sheet4").Select
ActiveSheet.Range("$A$1:$R$25239") _
.AutoFilter _
Field:=5, _
Criteria1:=Sheets("Sheet3").Application.Selection.Value
Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.Copy
Sheets("Sheet5").Select
Range("A1").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "+"
Sheets("Sheet3").Select
Selection.Offset(1, 0).Select
' This is where the code to stop the loop needs to go
Loop
End Sub
This question is a classic case of the XY Problem.
Y Solution
The main reason none of your four attempts to detect an empty cell work, is a lack of understanding on what Selection and ActiveCell actually are. They are properties of the Application object and return the following
Selection - the selected object of the active sheet (the top most sheet)
ActiveCell - the active cell of the active sheet (the top most sheet)
You can't use Sheets("Sheet3").ActiveCell or Sheets("Sheet3").Selection as the Sheet object doesn't have these properties.
What you can use is Application.ActiveCell and Application.Selection or, more simply, ActiveCell and Selection. Of course, this will only work after activating Sheet3.
My preferred way of doing this is:
Sheets("Sheet3").Activate
If (IsEmpty(ActiveCell)) Then Exit Do
Your code also contains a similar problem with this bit:
Criteria1:=Sheets("Sheet3").Application.Selection.Value
While the code correctly gets the Selection object, it doesn't actually activate Sheet3 and is exactly the same as writing:
Criteria1:=Application.Selection.Value or Criteria1:=Selection.Value
Fixing this issue by storing the Sheet3 selection value in a variable leads to the following working code:
Option Explicit
'(v0.2)
Public Sub Y_Fixed_BUT_VERY_VERY_VERY_BAD_CODE()
' Added three lines and changed a fourth to fix the incorrect usage of "Selection" for the criteria
' Changed a fifth line to add the correct loop exit code
Sheets("Sheet3").Activate ' Fix#1 Not necessary if the code is always run from Sheet3
Dim varSheet3ActiveCellValue As Variant ' Fix#2
Do
varSheet3ActiveCellValue = ActiveCell.Value2 ' Fix#3
Sheets("Sheet4").Select
ActiveSheet.Range("$A$1:$R$25") _
.AutoFilter _
Field:=5, _
Criteria1:=varSheet3ActiveCellValue ' Fix#4
Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.Copy
Sheets("Sheet5").Select
Range("A1").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "+"
Sheets("Sheet3").Select
Selection.Offset(1, 0).Select ' Fix#5
If IsEmpty(ActiveCell) Then Exit Do
Loop
End Sub
X Solution
As mentioned in response to your first posted question, you really, really need to learn how to avoid using .Select. This Stack Overflow post is a good place to start.
The following code is the equivalent to the above, without using a single .Select, .Activate, Selection, or ActiveCell. It also includes a better way to find the last value in a column. (Your method fails unless there is a least one cell containing a value after the first cell.)
A useful way to work out how the code works is to select a word in it, for example With and pressing F1. This will bring up the Excel Help related to that word, with explanations and examples.
'============================================================================================
' Module : <in any standard module>
' Version : 1.0
' Part : 1 of 1
' References : N/A
' Source : https://stackoverflow.com/a/47468132/1961728
'============================================================================================
Option Explicit
Public Sub X__GOOD_CODE()
Dim rngFilterCriteriaList As Range
With Sheets("Sheet3").Range("A3")
Set rngFilterCriteriaList = Range(.Cells(1), .EntireColumn.Cells(Rows.Count).End(xlUp))
End With
Dim rngCell As Range
For Each rngCell In rngFilterCriteriaList
Sheets("Sheet4").Range("A1:R25239") _
.AutoFilter _
Field:=Range("E:E").Column, _
Criteria1:=rngCell.Value2
Sheets("Sheet4").Range("A1").CurrentRegion.Copy _
Destination:=Sheets("Sheet5").Range("A:A").Cells(Rows.Count).End(xlUp).Offset(1)
Sheets("Sheet5").Range("A:A").Cells(Rows.Count).End(xlUp).Offset(1).Value2 = "+"
Next rngCell
Sheets("Sheet4").Cells.AutoFilter
End Sub
if u cannot specify the range then have to activated sheet3 then its works refer below:
ThisWorkbook.Worksheets("Sheet3").Activate
If ActiveCell = "" Then
Exit Do
End If
Your selection will not change if you are not changing the cell by using .select in the code and therefore will likely result in infinite loop. But using .select in the code is not considered as good practice as it slows down the process.
I'd suggest using For...each Loop like below.
Dim rng as Range
For each rng in selection
If Len(rng.Value) = 0 then Exit Sub '\\ Exit at first blank cell
'\\ Do process here
Next rng
selection can contain 1 or more cells. If you want to check if all the cells in the selection are empty you can use the worksheet function countblank which returns the number of empty cells. If the number of empty cells in the selection equals the number of cells in the selection then all the cells in the selection are empty. your test can be adapted like this
If Application.WorksheetFunction.CountBlank(Selection) = Selection.Count Then Exit Do
Your solution is here.
Credits to mvptomlinson from MrExcel.com
The right code is
'Your code to loop through copying sheets
If ActiveSheet.Range("A1").Value = "" Then Exit Sub
'Your code to continue if A1 isn't empty
I have the following code which filters based on what is typed into the textbox. This works for strings however it does not work for integer searches. Any idea what I might be doing wrong?
Private Sub TextBox1_Change()
On Error Resume Next
metin = TextBox1.Value
Set bul = Range("a4:a10").Find(What:=metin)
Application.Goto Reference:=Range(bul.Address), Scroll:=False
Selection.AutoFilter field:=1, Criteria1:=TextBox1.Value & "*"
If metin = "" Then
Selection.AutoFilter
End If
End Sub
Add Range("a4:a10").NumberFormat = "#" at the beginning. With numbers, Excel tries to compare values, not their digit representation as string. Hence, it tries to match exactly :) With that line it will treat digit sequence as string and will apply string comparison. The final code would be:
Private Sub TextBox1_Change()
Range("a4:a10").NumberFormat = "#"
On Error Resume Next
metin = TextBox1.Value
Set bul = Range("a4:a10").Find(What:=metin)
Application.Goto Reference:=Range(bul.Address), Scroll:=False
Selection.AutoFilter field:=1, Criteria1:=TextBox1.Value & "*"
If metin = "" Then
Selection.AutoFilter
End If
End Sub
For optimization sake, you should set the range format somewhere outside this method, so you don't have to do it every time the text box has changed.
I am trying to figure out the best way, on how to use Excel ListBox with multiple selections and have a simple VBA code for it to filter multiple sheets based on what is selected in the ListBox.
The code that I have right now is below. At the moment it does pretty much exactly what I need - checks if there is any filter in the sheets, cleans it if so, and then filters out the selected values. But what I need it to do as well, is that there is no value selected at all, it should clean the filters in 4 sheets and exit sub.
The thing is, that I get an "invalid procedure" error if I try to run it when nothing is selected. I did try to add an Else statement and another If to check If .Listindex = -1, but both of the options gave the exact same error.
As this needs to be a multiple selection list, I found that it also needs to loop while checking if nothing is selected, but yet again, had the same error.
How can I improve this code and add the required functionality?
Sub filter1()
Dim MyArray() As String
Dim Cnt As Long
Dim r As Long
Cnt = 0
With Me.ListBox1
If .ListIndex <> -1 Then
For r = 0 To .ListCount - 1
If .Selected(r) Then
Cnt = Cnt + 1
ReDim Preserve MyArray(1 To Cnt)
MyArray(Cnt) = .List(r)
End If
Next r
End If
End With
With Sheet1
If .FilterMode Then .ShowAllData
.Range("A2:Y1037").AutoFilter field:=2, Criteria1:=MyArray, Operator:=xlFilterValues
End With
With Sheet3
If .FilterMode Then .ShowAllData
.Range("A2:AB1037").AutoFilter field:=2, Criteria1:=MyArray, Operator:=xlFilterValues
End With
With Sheet4
If .FilterMode Then .ShowAllData
.Range("A2:Z1037").AutoFilter field:=2, Criteria1:=MyArray, Operator:=xlFilterValues
End With
With Sheet5
If .FilterMode Then .ShowAllData
.Range("A2:Z1037").AutoFilter field:=2, Criteria1:=MyArray, Operator:=xlFilterValues
End With
End Sub
Check if cnt is 0 before the line which says With Sheet1 and if cnt is 0 that means nothing was selected in the ListBox, prompt the user and use exit sub like below...
If cnt = 0 Then
MsgBox "No item was selected in the ListBox." & _
"Please select an item and then try again...", vbCritical, "No Item Selected"
Exit Sub
End If
With Sheet1
End With
Listindex doesnt help when you have multiselect. So instead of using If .ListIndex <> -1 Then checkt your cnt after your loop with
If cnt = 0 'nothing selected
'code for no selection
else
'code with selection
end if
I have an Excel 2010 workbook containing 2 sheets ("Contents" and "Folders").
The purpose of this workbook is to track different pieces of work by supplier or reference number, with a front-end (the Contents page) that is simple to use, consisting only of buttons and a search box (Which isn't actually a separate box, but simply the contents of cell J8 of the Contents sheet (hereafter referred to as J8) as typed by the user.
The buttons will filter by supplier type (and work perfectly fine) but it's the user selection that I'm having trouble with.
My code for this macro is:
Sub Find_Click()
Dim userSelect As String
userSelect = "*" & Range("J8") & "*"
Sheets("Folders").Select
ActiveSheet.Range("$B$1:$B$5000").AutoFilter Field:=2, Criteria:=userSelect, Operator:=x1And
End Sub
When the 'Find' button is pressed, this should read J8, then select the Folders sheet and filter the result to show every entry in column B that contains the text in J8.
This was working fine. However, now when I try to use this macro I get a 1004 run-time error with the 'Application-defined or object-defined error' message.
Can anyone please help?
EDIT:
The Contains buttons that have macros assigned that follow this format:
Sub Button1_Click()
Sheets("Folders").Select
ActiveSheet.Range("$A$1:$A$5000").AutoFilter Field:=1, Criteria1:= _
"Criteria"
Set r = Range(Range("A3"), Range("A3").End(xlDown))
j = WorksheetFunction.CountA(r.Cells.SpecialCells(xlCellTypeVisible))
'MsgBox j
If j = 0 Then
MsgBox "There is currently no work relating to Criteria"
ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A3").Select
Sheets("Contents").Select
End If
End Sub
There is also a resest button that clears a filter and returns to the Contents sheet:
Sub Reset_Click()
ActiveSheet.ShowAllData
Sheets("Contents").Select
End Sub
Generally, you'll need to activate a cell inside the range in which you are going to use the AutoFilter.
Further more, when you are trying to use AutoFilter with wildcards (* or ?) or math test, you'll need to add an = at the start of your criteria string, so
userSelect = "=*" & Range("J8") & "*"
Then, it is not Criteria, but Criteria1 and Criteria2 if you use a second one! So you don't need an Operator in this case.
And finally with ActiveSheet.Range("$B$1:$B$5000").AutoFilter Field:=2, you are asking the code to filter on the second column of a range where there is only one column!
So if you want to filter on col B, just change Field:=2 to Field:=1
Here is the working code :
Sub Find_Click()
Dim userSelect As String
Dim wS as Worksheet
userSelect = "=*" & Range("J8") & "*"
Set wS = Sheets("Folders")
wS.Activate
wS.Range("B1").Activate
If Not wS.AutoFilterMode Then wS.AutoFilterMode = True
wS.Range("$B$1:$B$5000").AutoFilter Field:=1, Criteria1:=userSelect
End Sub
And you also had a typo in xlAnd, it was x1And ;)
For anyone who is interested, the problem ended up being in the line:
ActiveSheet.Range("$B$1:$B$5000").AutoFilter Field:=2, Criteria1:=userSelect
As the code was filtering only column B, the Field value needed to be set to '1' instead of my original '2'
Thanks to #R3uK for his invaluable help!
I wrote this script to delete rows which contain a value in column C that is different than "201103". When I use this to bold it, it works, but when I use it with .Delete it behaves strange and does not work properly.
I was trying to get selected rows and than use UNION to merge it and use .SELECT (multiple) so I could delete it manually but not sure how to make it.
Sub test()
Dim Cell As Range
For Each Cell In Range("C2:C2308").Cells
If (Cell.Value <> "201103" And Cell.Value <> "") Then
Cell.EntireRow.Font.Bold = True
'Cell.EntireRow.Delete
End If
Next Cell
End Sub
Does anyone know how to fix it so it works fine?
Try this:
Sub test()
'
With ActiveSheet
.AutoFilterMode = False
With Range("C2", Range("C" & Rows.Count).End(xlUp))
.AutoFilter 1, "<>201103"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub