VBA - Search engine help

[Closed]
Report
-
Posts
2818
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 18, 2021
-
Hi guys,

These threads are really helpful but i still cant get mine to work. I have created a knowlege base on excel for all the fixes on my service desk and i am attempting to create a search engine for it. I have a macro that searches cells but i cant make it search within a cell. I.E. if i search "outlook" it will bring up outlook because sheet 3 cell A2-17 says 'Outlook' but if i try search "unable to open outlook" it wont find it becuase sheet 3 cell D4 say "user called unable to open outlook with error..." Any help on this would be greatly appreciated guys. Below is the macro I have:


Option Compare Text
Sub Find_Data()
Dim datatoFind
Dim sheetCount As Integer
Dim counter As Integer
Dim currentSheet As Integer
On Error Resume Next
currentSheet = ActiveSheet.Index
datatoFind = InputBox("Please enter one or more words of the users issue")
If datatoFind = "" Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.Count
If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
For counter = 1 To sheetCount
Sheets(counter).Activate
Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If ActiveCell.Value = datatoFind Then Exit Sub
Next counter
If ActiveCell.Value <> datatoFind Then
MsgBox ("We could not seem to see that fix, please check our spelling and try to refine your search with fewer words")
Sheets(currentSheet).Activate
End If
End Sub


1 reply

Posts
2818
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 18, 2021
486
Hi ITAnalyst,

You mean something like this:
Sub Find_Data()
Dim datatoFind
Dim sheetCount As Integer
Dim counter As Integer
Dim aCell As Range
On Error Resume Next
Set aCell = ActiveCell
datatoFind = InputBox("Please enter one or more words of the users issue")
If datatoFind = vbNullString Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.Count
For counter = 1 To sheetCount
Sheets(counter).Activate
Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If aCell <> ActiveCell Then Exit Sub
Next counter
If aCell = ActiveCell Then MsgBox ("We could not seem to see that fix, please check our spelling and try to refine your search with fewer words")
End Sub

Best regards,
Trowa