Solved: Problem: Coding search engine in Excel with VBA

[mdb]

Guys:

I can do the basics of Excel VBA programming, but I don't even know how to begin on this one--everything I've tried is a waste. Reading the posts, I know that you guys can handle it easily!

We have an excel workbook in which we are compiling dozens of worksheets--indexes to various drawings on our server. What we are wanting to do is create a search engine page as the first page of the workbook. When you enter a machine number and click "execute", the following will happen:

1. The macro will search in Column B of each of the sheets in the workbook to find the string machinenumber.
2. For each time it finds the string, I want the entire row around the cell (columns A through D) copied and pasted onto the "results" section of the Search Engine worksheet.
3. The macro then continues searching from that point forward.
4. It repeats this process on each worksheet in the file.


Any ideas? I've tried everything that I can think of but that might not be saying much.... Thanks!

[mvidas]

Hi mdb,

The user mdmackillop came up with a great search function for excel files, take a look at http://vbaexpress.com/kb/getarticle.php?kb_id=195

If you want to limit it to search only in column B and return A:D, change the FindAll sub to:Public Sub FindAll(Search As String, Reset As Boolean)

Dim WB As Workbook
Dim WS As Worksheet
Dim Cell As Range
Dim Prompt As String
Dim Title As String
Dim FindCell() As String
Dim FindSheet() As String
Dim FindWorkBook() As String
Dim FindPath() As String
Dim FindText() As Variant
Dim Counter As Long
Dim FirstAddress As String
Dim Path As String
Dim MyResponse As VbMsgBoxResult

If Search = "" Then
Prompt = "What do you want to search for in the worbook: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
'Delete default search term if required
Search = InputBox(Prompt, Title, "Enter search term")
If Search = "" Then
GoTo Canceled
End If
End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Save found addresses and text into arrays
On Error Resume Next
Set WB = ActiveWorkbook
If Err = 0 Then
On Error GoTo 0
For Each WS In WB.Worksheets
'Omit results page from search
If WS.Name <> "FindWord" Then
With WS.Columns(2)
Set Cell = .Find(What:=Search, After:=.Cells(.Rows.Count, .Columns.Count) _
, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, _
SearchOrder:=xlByColumns)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
Counter = Counter + 1
ReDim Preserve FindCell(1 To Counter)
ReDim Preserve FindSheet(1 To Counter)
ReDim Preserve FindWorkBook(1 To Counter)
ReDim Preserve FindPath(1 To Counter)
ReDim Preserve FindText(1 To Counter)
FindCell(Counter) = Cell.Address(False, False)
FindText(Counter) = Cell.EntireRow.Cells(1).Resize(1, 4).Value
FindSheet(Counter) = WS.Name
FindWorkBook(Counter) = WB.Name
FindPath(Counter) = WB.FullName
Set Cell = .FindNext(Cell)
Loop While Not Cell Is Nothing And Cell.Address <> FirstAddress
End If
End With
End If
Next
End If
On Error GoTo 0
'Response if no text found
If Counter = 0 Then
MsgBox Search & " was not found.", vbInformation, "Zero Results For Search"
Exit Sub
End If

'Create FindWord sheet in does not exist
On Error Resume Next
Sheets("FindWord").Select
If Err <> 0 Then
Debug.Print Err
'error occured so clear it
Err.Clear
Sheets.Add.Name = "FindWord"
Sheets("FindWord").Move After:=Sheets(Sheets.Count)
'Run macro to add code to ThisWorkbook
AddSheetCode
End If
'Write hyperlinks and texts to FindWord
Range("A3:B65536").ClearContents
Range("A1:B1").Interior.ColorIndex = 6
Range("A1").Value = "Occurences of:"
'Reset prevents looping of code when sheet changes
If Reset = True Then Range("B1").Value = Search
Range("A1:D2").Font.Bold = True
Range("A2").Value = "Location"
Range("B2").Value = "Cell Text"
Range("A1:B1").HorizontalAlignment = xlLeft
Range("A2:B2").HorizontalAlignment = xlCenter
'Adjust column width to suit display
Range("A:A").ColumnWidth = ScreenWidth / 60
For Counter = 1 To UBound(FindCell)
ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & Counter + 2), _
Address:="", SubAddress:=FindSheet(Counter) & "!" & FindCell(Counter), _
TextToDisplay:=FindSheet(Counter) & "!" & FindCell(Counter)
Range("B" & Counter + 2).Resize(1, 4).Value = FindText(Counter)
Next Counter
Range("B:E").EntireColumn.AutoFit
Range("B1").Select
Canceled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End SubShould do exactly as you need!
Matt

[mdb]

Fantastic. Thanks, guys--this works like a charm! I bow to your superiority in programming.

[mdb]

Sorry, double-post.

[mvidas]

I think you might have pasted over the AddSheetCode procedure when you replaced the FindAll sub. You should just be able to go to the entry again and re-copy/paste the AddSheetCode sub, that will hopefully take care of it!