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.
Related
I have various formulas in a spreadhseet that I need to convert to a different unit of measure.
Some are as simple a value such as 889 and others are a formula such as the below;
=Incision_Point_1x+(Arm_Depth_1-Graphic_Radius)
I'd like to use VBA to quickly take the existing formula / value and convert it to;
=(889/Unit_of_Measure_Multiplier)
=(Incision_Point_1x+(Arm_Depth_1-Graphic_Radius)/Unit_of_Measure_Multiplier)
How can I do this?
I used the following code;
Range("B3") = "=(" & Range("B3") & "/" & "Unit_Of_Measure_Multiplier)"
Which works perfectly when you have a whole number but deletes the formula and replaces it with a value for my second example, which defeats the point.
Additionally, how do I then apply this to a large data range? i.e. apply it to range B3:D100?
Try this code:
Sub test1()
For Each cl In Range("B3:D100")
If cl.HasFormula Then
v = Mid(cl.Formula, 2) 'remove leading =
Else
v = cl.Value
End If
frm = "=(" & v & "/Unit_Of_Measure_Multiplier)"
Debug.Print frm 'check that this is what you want
cl.Formula = frm
Next
End Sub
Please, try the next way:
Sub adaptFormula()
Dim rngFormula As Range, cel As Range
On Error Resume Next 'for the case of no formula in the range...
Set rngFormula = Range("B3:D100").SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If rngFormula Is Nothing Then Exit Sub
For Each cel In rngFormula.cells 'iterate only between cells having a formula
If InStr(cel.Formula, "=(Inc") > 0 Then
cel.Formula = Replace(cel.Formula, "Incision_Point_1x+(Arm_Depth_1-Graphic_Radius)", "889")
End If
Next
End Sub
Please, check if "Incision_Point_1x+(Arm_Depth_1-Graphic_Radius)" as you show us, is not "Incision_Point_1x + (Arm_Depth_1-Graphic_Radius" (spaces in front and after "+"), as it looks to me more probably. If so, please adapt the string to be replaced according to your real formula string...
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.
I've inherited some VBA code that attempts to save and restore filters in Excel 2010-2016 (I'm testing on Excel 2016 - 32bit, 16.0.4549.1000). I've already learned this is pretty much impossible to do properly and in a sane way (e.g. Get Date Autofilter in Excel VBA), but the number of different ways it can fail amazes me.
In particular, it seems that an xlFilterValues filter, which selects cells with value longer than 254 characters, can not be saved and restored:
the values in .Criteria1(i) are truncated to 256 chars when reading,
if you save the criteria array (saved = .Criteria1) and attempt to restore it later via .AutoFilter Criteria1:=saved ..., the .AutoFilter will report "Run-time error '13' Type Mismatch" if any Len(saved(i)) >= 256
The testcase, which can be run in an empty workbook is listed below.
Can everyone reproduce? Any thoughts on an easy way around this limitation?
Sub test()
Const CRITERIA_LEN = 257 ' 255 or less works, 256 throws error
Dim ws As Worksheet: Set ws = ActiveSheet
Dim filtRng As Range: Set filtRng = ws.Range(ws.Cells(1, 1), ws.Cells(5, 1))
Dim s100 As String: s100 = "1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890"
Const PREFIX_LEN = 2 ' the length of the "=X" prefix in Criteria1(i)
Dim longStr As String: longStr = Mid(s100 & s100 & s100, 1, CRITERIA_LEN - PREFIX_LEN)
ws.Cells(1, 1).Value2 = "header"
ws.Cells(2, 1).Value2 = "A" & longStr
ws.Cells(3, 1).Value2 = "B" & longStr
ws.Cells(4, 1).Value2 = "C" & longStr
ws.Cells(5, 1).Value2 = "another value"
If Not ws.AutoFilterMode Then
filtRng.AutoFilter
End If
SET_BREAKPOINT_HERE = 1
' after hitting the breakpoint use the autofilter to select the three long values by typing '123' into the autofilter search
Dim fs As Filters: Set fs = ws.AutoFilter.Filters
If Not fs.Item(1).On Then Exit Sub
Debug.Print "Operator = " & fs.Item(1).Operator ' should be xlFilterValues (7)
Debug.Print "Len(.Criteria1(1)) = " & Len(fs.Item(1).Criteria1(1)) ' this is never larger than 256
Debug.Print "Len(.Criteria1(2)) = " & Len(fs.Item(1).Criteria1(2))
Debug.Print "Len(.Criteria1(3)) = " & Len(fs.Item(1).Criteria1(3))
' Save the filter
Dim crit As Variant
crit = fs.Item(1).Criteria1
'crit = Array("=A" & longStr, "=B" & longStr, "=C" & longStr) ' This line has the same effect
ws.AutoFilter.ShowAllData ' reset the filter
' Try to restore
filtRng.AutoFilter Field:=1, _
Criteria1:=crit, _
Operator:=xlFilterValues
' => Run-time error '13' Type Mismatch
End Sub
I just came across this issue today also. Really unfortunate that this has this limitation. I think the best thing we can hope to do is the following.
Function MakeValid(ByVal sSearchTerm as string) as string
if len(sSearchTerm) > 255 then
MakeValid = Left(sSearchTerm,254) & "*"
else
MakeValid = sSearchTerm
end if
End Function
Sub Test()
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= MakeValid(sSearchTerm), Operator:=Excel.XlAutoFilterOperator.xlFilterValues
End Sub
Ultimately, the way it works, is it bypasses the problem by using a pattern search (so matches the first 253 characters, and then it searches for any pattern from there). This won't always work, in fact it is bound to not work at some points, but it seems this is the best option we have (other than designing our systems around this issue)
Seems like this also works for arrays:
Function MakeValid(ByVal sSearchTerm as string) as string
if len(sSearchTerm) > 255 then
MakeValid = Left(sSearchTerm,254) & "*"
else
MakeValid = sSearchTerm
end if
End Function
Sub Test()
Dim i as long
for i = lbound(sSearchTerms) to ubound(sSearchTerms)
sSearchTerms(i) = MakeValid(sSearchTerms(i))
next
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= sSearchTerms, Operator:=Excel.XlAutoFilterOperator.xlFilterValues
End Sub
It's kinda a bad solution but it sort of works
I've designed a search box that filters my table when text is entered into said search box. The problem is that it is soooo slow, it's almost not even worth having it in my workbook right now.
Can anyone think of any way to revise/improve upon this code?
Here is my code currently:
Private Sub TextBox1_Change()
Dim searchArea As Range, searchRow As Range, searchCell As Range
Dim searchString As String
Dim lastRow As Integer
Application.ScreenUpdating = False
searchString = "*" & LCase(TextBox1.Value) & "*"
Rows.Hidden = False
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set searchArea = Me.Range("f3:f791", "f3" & lastRow)
searchArea.EntireRow.Hidden = True
For Each searchRow In searchArea.Rows
For Each searchCell In searchRow.Cells
If LCase(searchCell) Like searchString Then
searchRow.Hidden = False
Exit For
End If
Next searchCell
Next searchRow
Application.Goto Range("Z1"), True
ActiveWindow.ScrollColumn = 1
Application.ScreenUpdating = True
End Sub
Edited my code to this:
Private Sub TextBox1_Change()
ActiveSheet.ListObjects("states").Range.AutoFilter Field:=1, _
Criteria1:="*" & [G1] & "*", Operator:=xlFilterValues
End Sub
However, this is not working. There are text and numbers in Field 1, and this only is filtering text, not the numbers...
This is definitely redundantly redundant, because your iteration is over a single column:
For Each searchRow In searchArea.Rows
For Each searchCell In searchRow.Cells '### searchRow ONLY HAS ONE CELL! This second/inner loop is totally unnecessary
If LCase(searchCell) Like searchString Then
searchRow.Hidden = False
Exit For
End If
Next searchCell
Next searchRow
Rewrite as:
For Each searchCell in searchArea.Cells '## Assumes searchArea is single column
searchCell.EntireRow.Hidden = Not (LCase(searchCell) Like searchString)
Next
That alone should improve performance, but I think AutoFilter is a better method, and you should be able to derive the basic code for that from the Macro Recorder.
This would look something like:
searchArea.AutoFilter Field:=1, Criteria1:="=" & searchString, _
Operator:=xlAnd, Criteria2:="<>"
This should filter to display only non-blank rows which contain your searchString
#Yowe3k's points about the range assigment should also be noted, and you may use the AfterUpdate event of the TextBox instead of the Change event.
UPDATE This might work to handle your mixed cases of numeric/text values. There might be a better way to do this but I don't see an obvious solution. The AutoFilter is meant to work with either text or numbers, but not both. So this attempts to convert numeric values to string representations. You may need to make changes elsewhere if the numeric values are referenced in formula, etc.
Dim arr, v
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects(1)
' ## Disable filter if it's on already
If tbl.Range.AutoFilter Then tbl.Range.AutoFilter
arr = tbl.DataBodyRange.Columns(1).Value
' ## Convert your range of mixed numeric/string to string
For v = LBound(arr, 1) To UBound(arr, 1)
If IsNumeric(arr(v, 1)) Then
arr(v, 1) = "'" & CStr(arr(v, 1))
End If
Next
' ## Put the string data back out to the worksheet
tbl.DataBodyRange.Columns(1).Value = arr
tbl.Range.AutoFilter Field:=1, _
Criteria1:="*" & CStr([G1]) & "*", Operator:=xlFilterValues
I'm automating an update I have to do and part of the macro I want to write needs specific text from what gets populated.
I have the following types of text in the same column for hundreds of rows:
ScreenRecording^naushi02^procr^10035
procr^10635^ScreenRecording^misby01
ScreenRecording^liw03^procr^10046
I've bold the text I need. I want to either replace the whole text with just what I need or place what I need in the next column, same row.
I had wrote something which worked for 60 or so lines before I realised that there are variations in the format. For the main, it's all the same which is why I didn't realise at first and I've spent a lot of wasted time writing something that is now useless... so I'm asking for expert help please.
Once I've got what I need from the first row, I need to move down until the last entry repeating.
I had some code which obviously didn't work fully.
I have thought about using the text 'ScreenRecording' in a search along with the special character which I can't find on my keyboard and then trying to copy all text from that point upto and including the 2nd numerical character. I don't know how to do this, if it would work or even if it's a good idea but because I've spent so much time trying to figure it out, I need some help please.
Thanks in advance
If you always want to return the value after the word 'ScreenRecording`, you can use the following function to do so.
Include it in a SubRoutine to replace in place if needed:
Function SplitScreenRecording(sInput As String) As String
Dim a As Variant
Const SDELIM As String = "^"
Const LOOKUP_VAL As String = "ScreenRecording"
a = Split(sInput, SDELIM)
If IsError(Application.Match(LOOKUP_VAL, a, 0)) Then
SplitScreenRecording = CVErr(2042)
Else
SplitScreenRecording = a(Application.Match(LOOKUP_VAL, a, 0))
End If
End Function
Sub ReplaceInPlace()
Dim rReplace As Range
Dim rng As Range
Set rReplace = Range("A1:A3")
For Each rng In rReplace
rng.Value = SplitScreenRecording(rng.Value)
Next rng
End Sub
if you want to replace:
Sub main2()
Dim key As String
Dim replacementStrng As String
key = "ScreenRecording"
replacementStrng = "AAA"
With Worksheets("mysheet01").columns("A") '<--| change "mysheet01" and "A" to your actual sheet name and column to filter
.Replace what:=key & "^*^", replacement:=key & "^" & replacementStrng & " ^ ", LookAt:=xlPart
.Replace what:="^" & key & "^*", replacement:="^" & key & "^" & replacementStrng, LookAt:=xlPart
End With
End Sub
while if you want to place what you need in the next column:
Sub main()
Dim myRng As Range
Set myRng = GetRange(Worksheets("mysheet01").columns("A"), "ScreenRecording^") '<--| change "mysheet01" and "A" to your actual sheet name and column to filter
myRng.Offset(, 1) = "value that I need to place in next row" '<--| change the right part of the assignment to what you need
End Sub
Function GetRange(rng As Range, key As String) As Range
With rng
.AutoFilter Field:=1, Criteria1:="*" & key & "*" '<--| apply current filtering
If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then '<--| if there are visible cells other than the "header" one
With .SpecialCells(xlCellTypeConstants)
If InStr(.SpecialCells(xlCellTypeVisible).Cells(1, 1), key & "^") > 0 Then
Set GetRange = .SpecialCells(xlCellTypeVisible) '<--|select all visible cells
Else
Set GetRange = .Resize(.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).row - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--|select visible rows other than the first ("headers") one
End If
End With
End If
.Parent.AutoFilterMode = False '<--| remove drop-down arrows
End With
End Function