VBA code to only show rows that contain similar text to an input field? - vba

I'm new to VBA and am trying to cobble together some code to allow a user to input a word (or several words) into a cell and then show a list of matching row entries.
I have tried the following code but am getting an "instring = type mismatch" error.
Note that "B3" is the field dedicated for the "search word" and column F is the column containing the text I want to search within. If the word is contained, I want to show that row and hide all rows that don't contain that word.
Sub Find_Possible_Task()
ROW_NUMBER = 0
SEARCH_STRING = Sheets("codeset").Range("B3")
ROW_NUMBER = ROW_NUMBER + 1
ITEM_IN_REVIEW = Sheets("codeset").Range("F:F")
If InStr(ITEM_IN_REVIEW, SEARCH_STRING) Then
Do
Cells(c.Row).EntireRow.Hidden = False
Loop Until ITEM_IN_REVIEW = ""
End If
End Sub
TIA!

Few bad coding conventions or even possibly downright errors:
It's a good practice to explicity declare the scope Public/Private of your Sub procedure
Unless you're passing the variables from some place else, they need to be declared with Dim keyword
Using Option Explicit will help you prevent aforementioned error(s)
(Subjective) variables in all caps are ugly and in most programming languages it is convention to reserve all caps variables names for constants (Const)
Option Explicit
Private Sub keep_matches()
Dim what As Range
Dim where As Range
Dim res As Range ' result
Dim lr As Long ' last active row
Dim ws As Worksheet: Set ws = Sheets("codeset")
lr = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
Set what = ws.Range("B3")
Set where = ws.Range("F1:F" & lr)
' we'll create an extra column for a loop in our .Find method
where.Copy
ws.Range("F1").EntireColumn.Insert
ws.Range("F1").PasteSpecial xlPasteValues
where.EntireRow.Hidden = True ' preemptively hide them all
Set where = ws.Range("F1:F" & lr)
Set res = where.Find(what, lookIn:=xlValues) ' ilook for matches, 1st attempt
If Not res Is Nothing Then ' if found
Do Until res Is Nothing ' repeat for all results
res.EntireRow.Hidden = False
res = "Checked"
Set res = where.FindNext(res)
Loop
Else
MsgBox("No matches were found")
where.EntireRow.Hidden = False ' we don't wanna hide anything
End If
ws.Range("F1").EntireColumn.Delete ' remove the extra help column for Find method
End Sub
Should work as expected.
If there are any question, let me know.

instead of instr(), consider range.find().
Sub Find_Possible_Task()
Dim SEARCH_STRING As String
Dim ITEM_IN_REVIEW As Range
Dim found As Range
Dim i As Integer
SEARCH_STRING = Sheets("Sheet1").Range("B3").Value
i = 1
Do
Set ITEM_IN_REVIEW = Sheets("Sheet1").Cells(i, 6)
Set found = ITEM_IN_REVIEW.Find(What:=SEARCH_STRING)
If found Is Nothing Then
ITEM_IN_REVIEW.EntireRow.Hidden = True
End If
i = i + 1
Loop Until ITEM_IN_REVIEW = ""
End Sub
alternatively, consider using filter table:
1. check if your table has filter on ==> if yes, pass. if no, turn on filter.
2. filter column F for keyword to contain value in cell B3.

Related

formula leaving whitespace

I have the following formula designed to flag rows in a ListObject:
=IF( [#[Is Closed]]="Y", "", "Y")
I have some vba code that looks for these value via StrCmp, and was surprised to find that the Text property of the cell was " Y " (as opposed to "Y").
There are some obvious easy work arounds but can someone explain why the formula is leaving whitespace and how to force it not to?
Cheers,
UPDATE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAllInColumn
' To find a value regardless of hidden rows and autofulter settings that can make
' other methods unreliable
'
' aSearchRange : the range of data to search, which MUST be a single column
' aLookUpVal : the value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function FindAllInColumn(aSearchRange As Range, aLookUpVal As Variant) As Excel.Range
Debug.Assert aSearchRange.Columns.Count = 1
Dim rngEach As Range
Dim rngResult As Excel.Range
For Each rngEach In aSearchRange
' Debug.Print rngEach.Address & ": Value " & rngEach.Text
' If IsValued(rngEach.Text) Then Stop
If (StrComp(rngEach.Text, aLookUpVal) = 0) Then
If rngResult Is Nothing Then
Set rngResult = rngEach
Else
Set rngResult = Application.Union(rngResult, rngEach)
End If
End If
Next rngEach
Set FindAllInColumn = rngResult
End Function
The FIX
StrComp(rngEach.Value2, aLookUpVal, vbTextCompare)
Changing .Text to .Value2 instead. Odd, but at least it works now
In general empty spaces in Excel sometimes cause a lot of problems. As the OP has found out himself, .Value2 seems like a universal problem-solver of many strange cases.
Try to select the cell and check the following code, it will print possible "hidden" empty spaces:
Option Explicit
Public Sub TestMe()
Dim rng As Range
Dim cnt As Long
Set rng = Selection
For cnt = 1 To Len(rng)
Debug.Print Asc(Mid(rng, cnt, 1))
Next cnt
End Sub

Wrong value is returned when calling a function from a cell

First post yall.
Long story short, in Excel, when I call the following function (it's in its own module) from a cell, it returns the wrong value. The function returns the correct value when calling it from a sub, as well as when I step through the code (to the end), but the moment I call it from Excel, it returns a different value. Background at the bottom.
Things I've Tried
Making it a Public Function
Giving it an argument
Changing the function and/or module name
Moving it out of a module
Restarting Excel
A bunch of random stuff
It really is just this specific function that's giving me this issue, simpler functions do what they're told. I have to assume it has something to do with the order of events Excel is doing things, or the limits of what parts of Excel a function can change.
Function ActiveDisciplineFilters()
Application.Volatile 'makes the function update automatically
Dim disccolumn As Range
Dim uniquedisc() As String
Dim uniquediscstring As String
'create a string of unique values from the Discipline column
i = 0
If Range("LayerList[Discipline]").SpecialCells(xlCellTypeVisible).Address = Range("LayerList[Discipline]").Address Then
ActiveDisciplineFilters = "None"
Exit Function
End If
For Each cell In Range("LayerList[Discipline]").SpecialCells(xlCellTypeVisible)
If InStr(1, uniquediscstring, cell.Value) = 0 Then
If i <> 0 Then
uniquediscstring = uniquediscstring & ", " & cell.Value
Else
uniquediscstring = cell.Value
i = 1
End If
End If
Next
ActiveDisciplineFilters = uniquediscstring
End Function
Background
In Excel, I have a table. I'm taking all the data in one specific column of that table and creating a string of the unique values in that range (separated by comma). That string must be placed in another cell, for reasons I don't need to get into. If a filter is applied to the column, the unique values update automatically.
What would make Excel give me the right answer when I call it from a sub, then the wrong one when I call it from a cell?
Unfortunately, none of the SpecialCells methods work in a UDF. If you need this to be run from the worksheet as a formula, then your code should look like this instead:
Function ActiveDisciplineFilters()
Application.Volatile 'makes the function update automatically
Dim disccolumn As Range
Dim uniquedisc() As String
Dim uniquediscstring As String
Dim i As Long
Dim cell As Range
Dim bHidden As Boolean
'create a string of unique values from the Discipline column
i = 0
For Each cell In Range("LayerList[Discipline]").Cells
If cell.EntireRow.Hidden = False Then
If InStr(1, uniquediscstring, cell.Value) = 0 Then
If i <> 0 Then
uniquediscstring = uniquediscstring & ", " & cell.Value
Else
uniquediscstring = cell.Value
i = 1
End If
End If
Else
bHidden = True
End If
Next
If Not bHidden Then uniquediscstring = "None"
ActiveDisciplineFilters = uniquediscstring
End Function

A way to verify specific filter contents

I have a spreadsheet that uses a filter on a few columns of data. One of these columns has 10 different possible values. I want to verify that there is a specific filter in place--that is, not just that autofiltermode = true--but to actually check what the value of that filter is. Is there a way to do this in vba?
For example, if I might want to make sure that the user is only looking at customers, 1 of the 10 values in my field. So I'm hoping I can say something like if filtervalue = "customers" then.
Additionally, I don't want to verify cell data, I'm asking if there's a way to verify a filter.
The sample code below will check for the criteria selections given the first cell of the range containing the filter, and the index of the column to check.
Option Explicit
Sub Test()
'first argument is first cell of headers being filtered
'second argument is column to check for filter criteria
Debug.Print GetCriteria(Sheet1.Range("A1"), 3)
End Sub
Function GetCriteria(rng As Range, lngFilterIndex As Long) As String
Dim strCriteria As String
Dim objFilter As AutoFilter
Dim lngCriteriaCount As Long
Dim lngCounter As Long
Set objFilter = rng.Parent.AutoFilter
' no autofilter
If objFilter Is Nothing Then
GetCriteria = ""
Exit Function
End If
' autofilter but no selection
If Not objFilter.Filters(lngFilterIndex).On Then
GetCriteria = ""
Exit Function
End If
' iterate criteria
strCriteria = ""
lngCriteriaCount = objFilter.Filters(lngFilterIndex).Count
If lngCriteriaCount = 1 Then
strCriteria = objFilter.Filters(lngFilterIndex).Criteria1
Else
For lngCounter = 1 To objFilter.Filters(lngFilterIndex).Count
strCriteria = strCriteria & objFilter.Filters(lngFilterIndex).Criteria1(lngCounter)
Next lngCounter
End If
GetCriteria = strCriteria
End Function

someExcel VBA: Cannot create a range object successfully

This is my first question here, so bear with me. I'm a security consultant working on a huge firewall migration, for which I got my VBA skill from under a thick layer of dust. So far I have managed to get all my issues resolved by searching, but this issue: I get errors when doing exactly how I find it everywhere.
What I want to do:
I have an array that contains (among other things), strings formatted like this: "A3:P59", representing a cell range.
Now, this are ranges within a table. When I get the address of a certain cell in the table, I want to test if it's in that range.
I wrote a test function:
Function TestCellRange() As Boolean
Dim tbl As ListObject
Dim cell, rng, test As range
Dim range As range
Dim bRow, eRow As Integer
Set tbl = shRulebase.ListObjects("tblBFFirewallRules")
shRulebase.Activate
With shRulebase
cell = tbl.DataBodyRange(5, 1).Address(False, False) 'it's this command that gives me issues
Set range = .range(.Cells(bRow, 1), .Cells(eRow, 16))
Debug.Print cell
'Set rng = shRulebase.range(range)
Debug.Print rng
Set test = Application.Intersect(cell, range(range(A3), range(P59)))
If test Is Nothing Then
MsgBox ("oops")
TestCellRange = False
Else
MsgBox ("yup yup")
TestCellRange = True
End If
End With
End Function
Now whatever I try, I keep getting blocked on the set range:
set range = .Range("A3:P59") -> will return "object required", on the "set test" line (if i use intersect (cell, range))
Set range = range("A3:P59") -> will return object variable or with block variale not set on the same line
Set range = .range(.Cells(bRow, 1), .Cells(eRow, 16)) -> will step through, but debug.print returns a type mismatch and "Set test = Application.Intersect(cell, range)" returns a "object required"
Any help would be really appreciated...I'm all to familiar with networks ip's and the bits and bytes of it, but here I am a bit out of my comfort zone and I need to finish this by tomorrow :(
Greetings,
Kraganov
EDIT Some More tries:
rng and cell as variant:
cell = tbl.DataBodyRange(5, 1).Address(False, False)
rng = .range("A3:P59").Address(False, False)
Set test = Application.Intersect(cell, rng)
==>I would get objects required
just using rng as range and trying to set it without "set"
rng = .range("A3:P59")
EDIT 2 : I found a way around using the range.
So what I was trying to do, was the following:
I had a table that contains information about firewall rules. However, not every line describes a rule. There are also lines that described the context in which the rules below that line were to be placed.
Outside of the table, aside of those lines there would be a cell with the range of cells for that context. I wanted to use that to describe the context for those rules, if I pulled them.
I ended up looping through the table rows and identifying those specific rows and setting a "context" variable when, a row like that was met.
Try setting the cell as well as following:
set cell = tbl.DataBodyRange(5, 1).Address(False, False)
What is cell? A Range?
You do not need to add 'set' to the range value assignment.
Try just
range = .Range("A3:P59")
Function TestCellRange() As Boolean
Dim tbl As ListObject
Dim cellToTest As Range
Dim testResult As Range
Set tbl = shRulebase.ListObjects("tblBFFirewallRules")
Set cellToTest = tbl.DataBodyRange.Cells(5, 1)
'or with one more level of indirection
'Set cellToTest = shRulebase.range(tbl.DataBodyRange.Cells(5, 1).Value)
Set testResult = Application.Intersect(cellToTest, [A3:P59])
If testResult Is Nothing Then
MsgBox ("oops")
TestCellRange = False
Else
MsgBox ("yup yup")
TestCellRange = True
End If
End Function
Thanks to the post of VincentG I found the working solution. Thanks for that.
Function TestCellRange() As Boolean
Dim tbl As ListObject
Dim cellToTest As range
Dim testResult As range
Set tbl = shRulebase.ListObjects("tblBFFirewallRules")
shRulebase.Activate
Set cellToTest = tbl.DataBodyRange.Cells(5, 1)
'or with one more level of indirection
'Set cellToTest = shRulebase.range(tbl.DataBodyRange.Cells(5, 1).Value)
Set testResult = Application.Intersect(cellToTest, range("A3:P59"))
If testResult Is Nothing Then
MsgBox ("oops")
TestCellRange = False
Else
MsgBox ("yup yup")
TestCellRange = True
End If
End Function

Referring to a header range even after columns are inserted

I have a spreadsheet as illustrated below:
.
The button with the green text allows me to expand and collapse columns A:F, according to the macro below.
The problem is that the macro refers specifically to columns A:F. If I were to insert an additional column under my main column header ("Läkemedelsinformation"), I would still only be able to collapse/expand columns A:F, unless I edit the code manually.
How do I go about making the macro detect the relevant columns dynamically based on the main column header?
Public Sub LKMinfo()
Dim SH As Worksheet
Dim Rng As Range
Dim obj As Variant
Dim BTN As Button
Dim iLen As Long
Const myColumns As String = "A:F" '<<===== Change
Const släkemedelsinformation As String = "Läkemedelsinformation" '<<===== Change
Const sHidden As String = " Hidden"
Const sVisible As String = " Visible"
Set SH = ActiveSheet
Set BTN = SH.Buttons(Application.Caller)
Set Rng = SH.Columns(myColumns)
With Rng.EntireColumn
.Hidden = Not .Hidden
If .Hidden Then
iLen = Len(sHidden) + Len(släkemedelsinformation)
BTN.Characters.Text = släkemedelsinformation & " Hidden"
With BTN.Characters(Start:=1, Length:=iLen).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.ColorIndex = 3 '\\ RED
End With
Else
iLen = Len(sVisible) + Len(släkemedelsinformation)
BTN.Characters.Text = släkemedelsinformation & " Visible"
With BTN.Characters(Start:=1, Length:=iLen).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.ColorIndex = 4 '\\ GREEN
End With
End If
End With
End Sub
You can find the columns using the .Find method, passing in the column header name.
I would advise to set the .Find to a range variable.
Dim col_header1 As Range, col_header2 As Range
Set col_header1 = Columns("A:Z").Find("header_name1")
Set col_header2 = Columns("A:Z").Find("header_name2")
You can then assess if you were successful in finding all of the headers. If all of the headers were found, you can assign the column number values and use them in your code.
If Not col_header1 Is Nothing And _
Not col_header2 Is Nothing Then
col_number1 = col_header1.Column
col_number2 = col_header2.Column
Else
MsgBox ("One or more of the columns were not found!")
Exit Sub
End If
Just name your range.
In the example below, I have three headers, and named that range "Barn" using the Name Box (that little field to the left of the function bar). For more help with this, see e.g. this video or any of great many found using a simple web search.
If I then insert a column after column B, the named range "Barn" just expands to include it. This is illustrated when I select the "Barn" range using the Name Box drop-down:
You can refer to this range in VBA as follows:
Dim r As Range
Set r = Range("Barn")
With r.EntireColumn
'... do stuff
So you don't need to specify which columns Range r should refer to anymore (e.g. A to F — don't need to specify that). You just say that r refers to the range named "Barn".