PDA

View Full Version : 'Search Engine' Help: String with 2 values



maggie
08-01-2011, 02:58 PM
I have created the following 'search engine' for an Excel file. This search tool looks for keywords then spits the results out on a "Home" sheet. This works well.

My Question is:
Say I want to search the keyword "Cat". However as the keyword "Cat" also means "Kitten", I would like the engine to return all values that say Cat and Kitten. As well as when "Kitten" is searched, I would like all Kitten and Cat values to be returned. Any Ideas on how to write this into my program. There are only two instances where this occurs so I could write it in per instance.

Ex. Cat also could be searched as Kitten
Dog could also be searched as Puppy. (Only two instances)

Thank you in advance ~ Maggie

Program Below

Private Sub cmdSearch_Click()

Worksheets("Home").Select
Range("A3:G65536").Select
Selection.Clear
Selection.RowHeight = StandardHeight
Dim ws As Worksheet, myvar As String, val1 As Range
Dim val2 As Range, tmp As Range, cnt As Integer
cnt = 0
myvar = InputBox("Please Enter a Keyword:")
If myvar = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
Set val1 = ws.Cells.Find(What:=myvar, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False)
If Not val1 Is Nothing Then
cnt = cnt + 1
Application.Goto val1
ActiveCell.EntireRow.Select
Selection.Copy
Worksheets("Home").Select
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Set tmp = val1
again:


Set val2 = ws.Cells.FindNext(After:=val1)
If val1.Address <> val2.Address And _
tmp.Address <> val2.Address Then
Application.Goto val2
ActiveCell.EntireRow.Select
Selection.Copy
Worksheets("Home").Select
Range("A2").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Set val1 = val2
GoTo again
End If
End If
Next ws
If cnt = 0 Then MsgBox "No Matches Found"
End Sub

GTO
08-01-2011, 09:42 PM
Greetings Maggie,

Welcome to vbaexpress :hi:

Not well tested, but I think/hope this should get you close:

Option Explicit

Sub exa()
Dim DIC As Object '<--- Dictionary
Dim wksHome As Worksheet
Dim wks As Worksheet
Dim rngFound As Range
Dim rngColA As Range
Dim i As Long
Dim strResponse As String
Dim strFirstAddress As String
Dim strSearchTerm As String
Dim arySearchTerms() As String

'// I wasn't sure what StandardHeight was, so substituted: //
Const STANDARD_HGT As Double = 12.75

'// Create references to the DIctionary and to our destination sheet. //
Set DIC = CreateObject("Scripting.Dictionary")
Set wksHome = ThisWorkbook.Worksheets("Home")

With wksHome
'// Using .Rows.Count, so that when/if you changed to 2007+ //
With Range(.Range("A3"), .Cells(.Rows.Count, "G"))
.Clear
.RowHeight = STANDARD_HGT
End With
End With

'// For more than one keyword, instruct user to seperate with x (I chose semi-colon).//
strResponse = Application.InputBox( _
Prompt:="Please enter keyword(s) you wish to search for." & vbCrLf & _
"If more than one word, seperate the words with" & vbCrLf & _
"semi-colon.", _
Title:="Search:", _
Type:=2)

'// In case cancelled or empty string, bail out. //
If strResponse = vbNullString Or strResponse = "False" Then
MsgBox "No search term entered - now exiting", 0, vbNullString
Exit Sub
End If

'// Using Split, even if only one keyword is supplied, we'll return an array to look//
'// through below. //
arySearchTerms = Split(strResponse, ";")

For Each wks In ThisWorkbook.Worksheets
'// I didn't see this in your code, but am presuming a bit. //
If Not wks.Name = "Home" Then

'// For each element in our array... //
For i = LBound(arySearchTerms, 1) To UBound(arySearchTerms, 1)
'// Trim any errant leading/trailing spaces... //
strSearchTerm = Trim(arySearchTerms(i))
'// Specify Nothing so the previous reference is not retained. //
Set rngFound = Nothing

'// Attempt to set a reference to the Found cell. //
Set rngFound = wks.Cells.Find(What:=strSearchTerm, _
After:=wks.Cells(wks.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
MatchCase:=False)

If Not rngFound Is Nothing Then
'// I was thinking that in order to prevent copying the same row //
'// twice (or more) in the case that a keyword appears more than //
'// once, or, 'Cat' and 'Kitten' appear in the same row, we would //
'// want to see if the row has been copied. So... I think that //
'// keeping track of the addresses in the first column might work. //
If Not rngFound.Column = 1 Then
Set rngColA = rngFound.Offset(, -1 * (rngFound.Column - 1))
Else
Set rngColA = rngFound
End If
'// Address of first Find, note External used. //
strFirstAddress = rngColA.Address(External:=True)

Do
'// If the External Address is not yet saved, add it to the //
'// Dictionary and Copy the row. //
If Not DIC.Exists(rngColA.Address(External:=True)) Then
DIC.Item(rngColA.Address(External:=True)) = Empty
rngColA.EntireRow.Copy _
wksHome.Cells(wksHome.Rows.Count, "A").End(xlUp).Offset(1)
End If

'// Attempt to find the next occurrence of the current keyword. //
Set rngFound = wks.Cells.FindNext(rngFound)
'//SAA //
If Not rngFound.Column = 1 Then
Set rngColA = rngFound.Offset(, -1 * (rngFound.Column - 1))
Else
Set rngColA = rngFound
End If
'// Loop until we run back into the first cell we found. //
Loop While Not rngColA.Address(External:=True) = strFirstAddress
End If
Next
End If
Next
End Sub

Hope that helps,

Mark

maggie
08-02-2011, 08:51 AM
Mark~

You gave me lots of ideas to improve my code!

Where do you declare what the array terms are? (At what point to I say that Kitty and Cat are in the same array?)

Would I still be able to search terms that are not in an array (Basically keep the funtion of my current code with the addition of the array?)

Could you use a simple If statement. Example

If val1=Cat Then
'something that makes it search for kitten too?
End If

Thank you

~Maggie

GTO
08-03-2011, 12:06 AM
Mark~

You gave me lots of ideas to improve my code!

Where do you declare what the array terms are? (At what point to I say that Kitty and Cat are in the same array?)

I am sorry, but I am not quite understanding what you are asking. Are you asking how the values get added to the array?


Would I still be able to search terms that are not in an array (Basically keep the funtion of my current code with the addition of the array?)

Could you use a simple If statement. Example

If val1=Cat Then
'something that makes it search for kitten too?
End If

Thank you

~Maggie

As written, you do not need to supply an array of values, but only one value, and more values if desired. Again, I think that I am missing what you are getting at.

Have you tried running the code?

Mark

maggie
08-03-2011, 10:22 AM
My original question was if I were to search ONE word how could I have it return values that were equal to that word as well as synonyms for that word.

I think the code you wrote is for searching multiple terms at one time rather than finding synonyms for one word. Synonyms would be predefined within the code.

I am more experienced with Word VBA and got a suggestion that it would be something like this: (this is in Word VBA so context may be off)



Sub SearchDemo()
Dim sSearchTerm As String
Dim i As Integer
Dim x As Integer
Dim arySearch(0, 1) As String
Dim bFoundIt As Boolean
Dim xRet As Integer


arySearch(0, 0) = "Cat"
arySearch(0, 1) = "Kitty"


sSearchTerm = InputBox("Enter Keyword")


'loop through the first dimensions
For x = 0 To UBound(arySearch)
'and the second dimensions
For i = 0 To UBound(arySearch, 2)
If UCase(sSearchTerm) = UCase(arySearch(x, i)) Then
bFoundIt = True
xRet = x
End If
Next
Next
If bFoundIt Then
'found it, indicate success by using the first term
MsgBox "You want to search for: " & arySearch(xRet, 0)
Else
MsgBox "Didn't find a category for: " & sSearchTerm
End If
End Sub


Hopefully my question makes more sense. I want to preform this in Excel rather than word and work it into my existing code. :dunno