Searching an Excel column for containing text [duplicate] - vb.net

I currently have an Excel file with 1 column and many rows. The column holds a first name, last name, and possibly a middle name (EXAMPLE: John Abe Smith). I am writing a macro that has 1 textbox and 1 button. In the excel sheet I have a couple names:
Column A
--------
John Abe Smith
Cindy Troll Bee
Randy Row
Joe Jumbo
Katie Kool Kat
I want to write a macro that when I type something in the textbox and click the button, it will look in this column for the name. If it finds it, then just say "found" in a message box.
I want to use the wildcard "*" when searching the names, but I do not know how. I currently have some code like this, but the wildcard does not work:
Private Sub search_Click()
For firstloop = 3 To 10
If Range("G" & firstloop).Text = name.Text & "*" Then
MsgBox "Found!"
Exit Sub
Else
MsgBox "NOT FOUND"
End If
Next
End Sub
For example, let's say I type in "Troll" in the text box and I click the button. I want the loop to go through the column to find anything with "Troll" in it. The result from the example data would be just Cindy Troll Bee.
How could I go about doing this?

You can use Like operator (case-sensitive):
Private Sub search_Click()
For firstloop = 3 To 10
If Range("G" & firstloop).Text Like name.Text & "*" Then
MsgBox "Found!"
Exit Sub
Else
MsgBox "NOT FOUND"
End If
Next
End Sub
for case-insensitive search use:
If UCase(Range("G" & firstloop).Text) Like UCase(name.Text) & "*" Then
Also if you want to determine whether cell contains text (not only starts with text), you can use (case-sensitive):
If InStr(1, Range("G" & firstloop).Text, name.Text) > 0 Then
or (case-insensitive)
If InStr(1, Range("G" & firstloop).Text, name.Text, vbTextCompare) > 0 Then
UPD:
If the point only to show msgbox, then I'd suggest to use Application.Match:
Private Sub search_Click()
If Not IsError(Application.Match("abc" & "*", Range("G3:G10"), 0)) Then
MsgBox "Found!"
Else
MsgBox "NOT FOUND"
End If
End Sub

You can also avoid a loop and use the Range.Find Method. You can pass as option if you want it case sensitive or not. (By default it is not case sensitive.)
Set rngFound= Range("G" & firstloop).Find(name.Text & "*")
If rngFound Is Nothing Then
MsgBox "Not Found!"
Else
MsgBox "FOUND"
End If

Related

How to vlookup another excel sheet in VBA

Sub lookuphcpcs()
On Error GoTo errorbox:
Dim hcpcs_code As Long
Dim desc As Variant
hcpcs_code = ActiveCell.Value
If Len(hcpcs_code) > 0 Then
desc = Application.WorksheetFunction.VLookup(Active_cell, 'C:\Users\Username\Desktop\[Fruit Code.xlsx]Sheet1'!$A$2:$B$7, 2, False)
MsgBox "Description for HCPCS Code " & hcpcs_code & " is """ & desc & """"
Else
MsgBox "You did not enter any input!"
End If
Exit Sub
errorbox:
If Err.Number = 1004 Then
MsgBox "No Description found under HCPCS list!"
End If
End Sub
I am not able to put table array value under Vlookup in VBA to point to another excel sheet.
How do I do that?
First, when working with Vlookup you need to handle errors, such as when Vlookup was unable to find a match, you can use If Not IsError(Application.VLookup(.... to achieve this.
Second, in your case you don't need to use On Error GoTo errorbox:, just use the Vlookup error handling I wrote in the first point.
Third, you can use If Trim(ActiveCell.Value2) <> "" Then to verify there is a valid text or number inside ActiveCell rather than empty spaces.
Fourth, you should avoid using ActiveCell, and use fully qualified object instead.
Last, you want to make sure "Fruit Code.xlsx" workbook is open before using the Vlookup, as suggested by #Tim Williams in the comments above.
Modified Code
Option Explicit
Sub lookuphcpcs()
Dim desc As Variant
Dim SourceWb As Workbook
' error trapping in case Fruit Code workbook is closed
On Error Resume Next
Set SourceWb = Workbooks("Fruit Code.xlsx")
On Error GoTo 0
If SourceWb Is Nothing Then
Set SourceWb = Workbooks.Open("C:\Users\Username\Desktop\Fruit Code.xlsx") ' open workbook if it's closed
End If
If Trim(ActiveCell.Value2) <> "" Then ' make sure cell has a string other than space
If Not IsError(Application.VLookup(ActiveCell.Value2, SourceWb.Sheets("Sheet1").Range("A2:B7"), 2, 0)) Then
desc = Application.VLookup(ActiveCell.Value2, SourceWb.Sheets("Sheet1").Range("A2:B7"), 2, 0)
MsgBox "Description for HCPCS Code " & ActiveCell.Value2 & " is """ & desc & """"
Else
MsgBox "No Description found under HCPCS list!"
Exit Sub
End If
Else
MsgBox "You did not enter any input!"
End If
End Sub

How to check if string appears in worksheet *twice* Excel VBA?

I'm trying to check if a certain string appears on a given sheet twice. So far, I'm only able to check if the string appears once:
For Each curr In wb.Worksheets(1).UsedRange
If InStr(1, curr.Value, searchString) > 0 Then
MsgBox ("searchString appears once")
End If
Next
How do I check the UsedRange to see if the value appears twice? This needs to be a macro (so far I've found formulas that do this).
If WorksheetFunction.CountIf(Worksheets(1).UsedRange, "*" & searchString & "*") > 1 Then
MsgBox searchString & " appears more than once"
End If
Set a flag when you find the first match, then check to see if the flag is set:
Dim first As Boolean
For Each curr In wb.Worksheets(1).UsedRange
If InStr(1, curr.Value, searchString) > 0 Then
If first Then MsgBox ("searchString appears twice")
first = True
End If
Next

Macro to change tab name based on cell value with special duplicate handling

I have a macro that changed a tab name based on cell value (A4) which contains a formula to give the sheet a unique name, but I wanted to see if it was possible to create special case handling occurrences when there's a duplicate. So here's the code:
Sub RenameFromA4()
Dim Msg As String, i As Integer
For i = 5 To Sheets.Count
If Sheets(i).Range("A4").Value = "" Then
Msg = "Sheet " & i & "(" & Sheets(i).Name & ") has no value in A4. Fix sheet, then rerun."
MsgBox Msg, vbExclamation
Exit Sub
Else
On Error GoTo ErrSheetName
Sheets(i).Name = Sheets(i).Range("A4").Value
On Error GoTo 0
End If
Next i
Exit Sub
ErrSheetName: Msg = "Sheet " & i & "(" & Sheets(i).Name & ") could not be renamed. Check if name already used."
MsgBox Msg, vbExclamation
End Sub
The trouble I run into is sometimes duplicates can arise and error out my whole macro where it comes to a complete halt. So I want to add a sequence that when the macro encounters a duplicate add the following formula in cell B3: ="IF(AND(C4="",D4="",D3="",C3=""),TRIM((MID(A2,FIND(":",A2)+2,20))),"")&IF(IFERROR(FIND("West",A2),0)>0," W","")&" "&TRIM(RIGHT(SUBSTITUTE(A2," ",REPT(" ",255)),255))"
and pick from the error or just go back to rerunning the macro.
Any insight on how I can't structure this will be helpful.
You can explicitly check for the existence of a sheet named the same as the value in B4 by using a function like what is described here: Test or check if sheet exists. Then, you can insert something like the following between your On Error... and Sheets(i).Name...:
On Error GoTo ErrSheetName
If SheetExists(Sheets(i).Range("A4").Value) Then
Sheets(i).Range("B3").Formula = "=IF(AND(C4="",D4="",D3="",C3=""),TRIM((MID(A2,FIND(": ",A2)+2,20))),"")&IF(IFERROR(FIND("West ",A2),0)>0,"W ","")&""&TRIM(RIGHT(SUBSTITUTE(A2,"",REPT("",255)),255))"
End If
Sheets(i).Name = Sheets(i).Range("A4").Value

VBA Textbox value loop vlookup for number of times value is found

I am creating a table in my spreadsheet that contains categories, questions and answers for a quiz.
The user is presented with a form, allowing them to navigate around the workbook easily, this also includes a textbox option, allowing them to search for a phrase if they are unsure what category the question/answer may fall into.
I have generated a vlook up to pull from the table of categories/questions and answers to the user on a different worksheet.
I have also generated a count, so I am able to identify how many times this work appears across the quiz table.
My problem is I am struggling to develop a loop so that if the key phrase is found 6 times for example, i want 6 questions and answers to be listed to the user. Currently it is only pulling the final time it is found.
My current code includes the following:
Private Sub CommandButton1_Click()
If Len(search_text) = 0 Then
MsgBox "Please enter a key word to search for!", vbCritical
End If
Dim wordCount As Integer
wordCount = Application.WorksheetFunction.CountIf(Sheet1.Range("A2:c600"), "*" & search_text.Value & "*")
'Else: wordCount = WorksheetFunction.CountIf(Sheet1.Range("A2:c600"), search_text.Value)
If wordCount = 0 Then
MsgBox "No match found"
Else
Sheet2.Range("a7").Value = WorksheetFunction.VLookup("*" & search_text.Value & "*", Sheet1.Range("A2:c600"), 3, False)
Sheet2.Range("b7") = wordCount
End If
End Sub
Any advice on implementing a loop and to allow the question/answer to be printed one after another would be very much appreciated.
I have read many other question pages about this and none seem to match what I am trying to do.
Many thanks in advance
I use a combination of Find and FindNext to search through a range of cells for the term entered in the search_text input field. I added comments to my code to better help you understand what exactly is going on.
I don't know exactly what you need to do with the results when you find them, for now I just display a message box showing the match. We can work on what to actually do with the results if you want to clarify in the comments what exactly you want.
This code assumes you have a worksheet named Results
Private Sub CommandButton1_Click()
Dim rngResult As Range
Dim strFirstAddress As String
Dim i As Long
If Len(search_text.Text) = 0 Then
MsgBox "Please enter a key word to search for!", _
vbCritical
'Stop code exeuction if no search
'term is entered
Exit Sub
End If
'Clear the previous results range
Sheets("Results").Range("A2:C600").ClearContents
'Set i to row 2 of the results worksheet
i = 2
'Look in range A2:C600 of Sheet1
With Sheet1.Range("A2:C600")
'Perform the initial find
Set rngResult = .Find(What:=search_text.Text, LookAt:=xlPart)
'Check to ensure that the term is found
If Not rngResult Is Nothing Then
'Grab the cell address of the first match
'This will help to avoid an infinite loop
strFirstAddress = rngResult.Address
'Continue Searching
Do
'Display the output to you
'MsgBox "Matched '" & search_text.Text & "' to " & rngResult.Value & " in cell " & rngResult.Address
'Put the result on the results page
Sheets("Results").Range("A" & i & ":C" & i).Value = Range("A" & rngResult.Row & ":C" & rngResult.Row).Value
i = i + 1
'Move on to the next result
Set rngResult = .FindNext(rngResult)
'Break out of the loop when we return to the starting point of the search
Loop While Not rngResult Is Nothing And rngResult.Address <> strFirstAddress
End If
End With
'Clean up variables
Set rngResult = Nothing
End Sub

Count if cell not blank

Hi All I have 2 formulas i'm trying to run but struggling to get the COUNTIF to calculate only if the cell isn't blank.
Sheets("Home").Select
If Range("A2:A14").Count = "13" Then
MsgBox "Current Load Full Please Complete & Export", vbCritical
Exit Sub
End If
2nd Code
Sheets("Home").Select
If Range("A2:A14").Count < "13" Then
MsgBox "Shipment is short do you want to continue?", vbCritical vbYesNo
Exit Sub
End If
On the 2nd code if vbYes then run code if vbNo then exit sub.
If you're trying to do some action depending on the condition "all cells in range A2:A14 are filled or not" - then this code might be the answer.
Sub check_count()
Sheets("Home").Select
Dim myRange As Range
Set myRange = Worksheets("Home").Range("A2:A14")
'using excel's built in function CountA to check count of non-blank cells
'if the count is 13 - then msgbox
If Application.WorksheetFunction.CountA(myRange) = 13 Then
MsgBox "Current Load Full Please Complete & Export", vbCritical
Exit Sub
'if the count is less then 13 - then do following
Else:
msg1 = MsgBox("Shipment is short do you want to continue?", vbYesNo)
If msg1 = vbYes Then
MsgBox "Enter missing products in A2:A14" 'you can run some code here as well
Else: Exit Sub
End If
End If
End Sub
Hope this answers your question.
In order to count all non-blank cells in a given range, you could use:
If ActiveSheet.Range("A2:A14").SpecialCells(xlCellTypeConstants).Count < 13 Then