Solved: Search For and then Go To Searched Reference in Workbook

[Dodders]

Hi,
I'm updating a price list that has a header/index page with the relevant products on seperate worksheets.
From the header/index page the user is given buttons to click to take them to the relevant page. This is all works fine.

However, I require a search function from this header page for the user to search for a particular key word or string and then be taken directly to the relevant price list page.
I've managed to create a macro for a search string, however, this only points to the cell reference on the header/index page without taking the user to the cell reference/searched string.

Any assistance is greatly appreciated.

The macro VBA search is:

[VBA]Sub SearchBooks()
SearchWord = InputBox("Enter the string to search for")
For i = 1 To Workbooks.Count
Workbooks(i).Activate
Range("A1").Activate
FindAnother:
Set WordAddress = Cells.Find(What:=SearchWord, after:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If WordAddress Is Nothing Then
MsgBox ActiveWorkbook.Name & Chr(13) & "Search string not found"
Else:
If WordAddress.Address = CheckCell Then GoTo NextBook
If ActiveCell.Address = "$A$1" Then CheckCell = WordAddress.Address
Address = WordAddress.Address
MsgBox ActiveWorkbook.Name & Chr(13) & Address
Range(Address).Activate
GoTo FindAnother
End If
NextBook:
Next i
End Sub[/VBA]

If required I can send a stripped down copy of the workbook.

Thanks in advance
Simon

[MikeO]

I'm not sure how CheckCell is incorporated into the code, and you may need to post a copy of the workbook to clarify the question if this doesn't answer it....but, to take the user to the cell, you just need to select it.

[vba]Sub SearchBooks()
SearchWord = InputBox("Enter the string to search for")
For i = 1 To Workbooks.Count
Workbooks(i).Activate
Range("A1").Activate
FindAnother:
Set WordAddress = Cells.Find(What:=SearchWord, after:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If WordAddress Is Nothing Then
MsgBox ActiveWorkbook.Name & Chr(13) & "Search string not found"
Else
If WordAddress.Address = CheckCell Then GoTo NextBook
If ActiveCell.Address = "$A$1" Then CheckCell = WordAddress.Address
Address = WordAddress.Address
WordAddress.Select
MsgBox ActiveWorkbook.Name & Chr(13) & Address
Range(Address).Activate
GoTo FindAnother
End If
NextBook:
Next i
End Sub
[/vba]

Hope that helps.

[Zack Barresse]

Hi Simon, welcome to the board!

Dimension your variables, define CheckCell, post all of your code, and define what worksheets you are working with (you have not explicitly referenced any of them).

[tstav]

Simon,
Are you sure you don't mean "Worksheets" wherever you use "Workbooks"?

[Dodders]

Hi, Thanks for this.
I've attached an extract of the file.

Tstav - yes, I mean worksheets, I was trying to reference all active sheets within the workbook. As you can see, each product has one worksheet with multiple options identified as -1, -2 etc etc.

Trying to get the search function to search through the active worksheets and take the user to the first string found.

Really appreciating your assistance.
Simon

[tstav]

Hi Simon
I saw your workbook.
Here's what we can do:
Create a button on your Header Worksheet (btnFindWord). Assign this code to it:
[vba]Private Sub btnFindWord_Click()
Call SearchKeywordInSheets
End Sub
[/vba]

In one of your modules place the following code:
It searches for the entered keyword in all Worksheets except for the "header" worksheet. If not found you get no answer else the found cell is selected.

[vba]Sub SearchKeywordInSheets()
Dim Sht As Worksheet, cell As Range
SearchWord = InputBox("Enter the string to search for")
For Each Sht In Worksheets
If Sht.Name <> "header" Then
With Sht
Set cell = .Cells.Find(What:=SearchWord, after:=.Range("A1"), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then 'found it
.Activate
.Range(cell.Address).Select
Exit For
End If
End With
End If
Next 'Sht
End Sub
[/vba]

[tstav]

Or better yet, here's a code update with a message in case the keyword is not found
[vba]Sub SearchKeywordInSheets()
'----------------------------------------------------------
'Search for the input keyword across the Worksheets' cells
'except for the "host" Worksheet. If found, select the cell
'----------------------------------------------------------
Dim Sht As Worksheet, cell As Range, SearchWord as String
SearchWord = InputBox("Enter the string to search for")

For Each Sht In Worksheets
If Sht.Name <> "header" Then
With Sht
Set cell = .Cells.Find(What:=SearchWord, after:=.Range("A1"), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then 'found it
Exit For
End If
End With
End If
Next 'Sht
If Not cell Is Nothing Then 'found it
Sht.Activate
Sht.Range(cell.Address).Select
Else
MsgBox "Entered string not found", , "Search result"
End If
End Sub
[/vba]

[Dodders]

Hey tstav,
Firstly - thanks for the update, the second code works great. So easy when you know what you're doing!

Secondly, now I realise that there will also be multiple entries for this key word... Is there a loop function that can be added to the search function so you can loop through all the searched words in the workbook?

For example, searching for "GSS6100" in the workbook at present will go to "RevisionNotes" page and then end the search.
In reality, the user may need to reference all search string values of "GSS6100" and navigate through the workbook from this search string.
If you use the standard "Find and Replace" search in Excel, GSS6100 will appear on sheets "RevisionNotes", "GSS6100" and "SimSUPPORT". Ideally I'd like the search function to do the same sort of thing.
So... if the user finds the required item, they can close the search box, alternatively, if they don't find the right item they can click "next" and navigate to the next page. The search string would then need to go back to the "header" page... I know this a lot to ask!

I've attached the copy again with the updated code including the maintenance page called "SimSUPPORT" which will list the multiple products, if you need any clarification let me know.

Thanks in advance.
Simon

[Zack Barresse]

Hi there, first take a look here...

http://vbaexpress.com/kb/getarticle.php?kb_id=390
http://vbaexpress.com/kb/getarticle.php?kb_id=344
http://vbaexpress.com/kb/getarticle.php?kb_id=808
http://vbaexpress.com/kb/getarticle.php?kb_id=975

[Dodders]

Hi firefytr, thanks for your assistance.

Also, thanks for the re-directs. I've adapted (lvbaexpress.com)kb/getarticle.php?kb_id=808 as much as I can, however, the search funtion for this one only searches for the active sheet you are in.
I've been trying to get your code in document (lvbaexpress.com)kb/getarticle.php?kb_id=390 so that this search function will repeat through all the active worksheets.

I like both ideas but not sure if they can be integrated to work together.

Help! I'm pulling my hair out now!

Thanks in advance.
Simon

[Zack Barresse]

Post the code you are using now.

[tstav]

Hi Dodders,
Let me first put in words what I have done, so that you know right from the start if the following suits your needs.
1. No matter what the active worksheet is (be it the header worksheet or any other), the users can press Ctrl+Shift+F or Ctrl+Shift+f in order for a floating window to pop up.
2. In this window they can enter the keyword you're talking about and press the appropriate button for the search. The search goes on step by step through all the worksheets (except for the header Ws, as you asked).
3. The search goes forwards and backwards.

You should only create the little userform with the following buttons (apart from the textbox for the keyword):
Button "FindFirst": Finds the first occurence.
Button "Next": Locates and shows the next occurence (if any).
Button "Previous": Locates and shows the previous occurence (if any).
Button "Exit": Closes the window.

The found occurences are highlighted/dehighlighted accordingly. Any cells that are already colored before the highlighting, are restored to their original color.

You'll have to add the code at
-the ThisWorkbook module
-the general purpose code module
-and a userform (ufmSearch) which is the Search Window.

Hope it's what you want!
Regards, tstav

This is for the ThisWorkbook Class Module:
[vba]Option Explicit
Private Sub Workbook_Open()
Application.OnKey "^%F", "ShowSearchDialog" 'Assign shortcut keys
Application.OnKey "^%f", "ShowSearchDialog"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "^%F" 'Restore shortcut keys
Application.OnKey "^%f"
On Error Resume Next
ResetCellColor
Unload ufmSearch
End Sub
[/vba]

This is for the ufmSearch Userform Class Module:
[vba]Option Explicit
'----------------------------------------------
'FindNextCell Application
'Pop-up search window through keyboard shortcut
'----------------------------------------------
Private Sub UserForm_Initialize()
Me.txtSearch.SelectionMargin = False
Me.txtSearch.TabIndex = 0
Me.btnFindFirst.TabIndex = 1
Me.btnFindFirst.TakeFocusOnClick = False
Me.btnPrevious.TabIndex = 2
Me.btnPrevious.TakeFocusOnClick = False
Me.btnNext.TabIndex = 2
Me.btnNext.TakeFocusOnClick = False
Me.btnExit.TabIndex = 3
Me.btnExit.TakeFocusOnClick = False
Me.btnPrevious.Enabled = False
Me.btnNext.Enabled = False
Me.btnFindFirst.Default = True
Me.btnExit.Cancel = True
End Sub
Private Sub UserForm_Activate()
Dim I As Integer, Sht As Worksheet
'----------------------------------------------------------
'First load an array with all the to-be-searched worksheets
'----------------------------------------------------------
For Each Sht In Worksheets
If Sht.Name <> "header" Then
I = I + 1
ReDim Preserve Arr(1 To I)
Arr(I) = Sht.Name
End If
Next
Me.txtSearch.SetFocus
End Sub
Private Sub btnFindFirst_Click()
'--------------------------------------------------------
'Find first occurence. If found, select. Else notify.
'--------------------------------------------------------
'VBF,Dodders
'Search For and then Go To Searched Reference in Workbook
'--------------------------------------------------------
Dim I As Integer
'Exit if nothing has been entered
If Trim(Me.txtSearch.Text) = "" Then Exit Sub
intCurSheet = 1
'Search in each Worksheet
For I = intCurSheet To UBound(Arr)
With Worksheets(Arr(I))
Set curCell = .Cells.Find(What:=Me.txtSearch.Text, _
After:=.Cells(.Rows.Count, .Columns.Count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not curCell Is Nothing Then Exit For
End With
Next 'I
'If found
If Not curCell Is Nothing Then
ResetCellColor
curCell.Parent.Activate
lastColor = curCell.Interior.ColorIndex
curCell.Interior.ColorIndex = 4
Set prevCell = curCell
curCell.Select
intCurSheet = I 'Store the current Worksheet's index

'---------------------------------
'Check existence of next occurence
'---------------------------------
If NextCellExists(curCell) Then
Me.btnNext.Enabled = True
End If
'If not found, notify
Else
MsgBox "Entered string not found", , "Search complete"
End If
End Sub
Private Sub btnNext_Click()
'--------------------------------------------------------------
'Select the next cell and update the current Worksheet's index
'--------------------------------------------------------------
ResetCellColor
Set prevCell = curCell
intPrevSheet = intCurSheet
Set curCell = nextCell
intCurSheet = intNextSheet
curCell.Parent.Activate
lastColor = curCell.Interior.ColorIndex
curCell.Interior.ColorIndex = 4
curCell.Select
'Enable the FindPrevious button
Me.btnPrevious.Enabled = True
'Enable/Disable the FindNext button
Me.btnNext.Enabled = IIf(NextCellExists(curCell), True, False)
End Sub
Private Sub btnPrevious_Click()
'--------------------------------------------------------------
'Select the previous cell and update the current Worksheet's index
'--------------------------------------------------------------
ResetCellColor
Set nextCell = curCell
intNextSheet = intCurSheet
Set curCell = prevCell
intCurSheet = intPrevSheet
curCell.Parent.Activate
lastColor = curCell.Interior.ColorIndex
curCell.Interior.ColorIndex = 4
curCell.Select
'Enable the FindNext button
Me.btnNext.Enabled = True
'Enable/Disable the FindPrevious button
Me.btnPrevious.Enabled = IIf(PreviousCellExists(curCell), True, False)
End Sub
Private Sub txtSearch_Change()
'------------------------------------------------------
'In case new string is entered while search is running,
'allow only "Find first" (start from beginning)
'------------------------------------------------------
Me.btnNext.Enabled = False
Me.btnPrevious.Enabled = False
End Sub
Private Sub btnExit_Click()
ResetCellColor
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then ResetCellColor
End Sub
[/vba]

This is for the general purpose code Module:
[vba]Option Explicit
Public Arr() As String
Public intCurSheet, intNextSheet, intPrevSheet As Integer
Public curCell, nextCell, prevCell As Range
Public lastColor As Variant
Sub ShowSearchDialog()
'-----------------------------------
'Belongs to FindNextCell Application
'-----------------------------------
Load ufmSearch
ufmSearch.Show vbModeless
End Sub
Function NextCellExists(ByVal cell As Range) As Boolean
'----------------------------------------
'Check current Sheet for next cell.
'If not found move to next Sheet.
'If found store the Sheet's index.
'----------------------------------------
With Worksheets(Arr(intCurSheet))
Set nextCell = .Cells.Find(What:=ufmSearch.txtSearch.Text, After:=cell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'If found
If Not nextCell Is Nothing And nextCell.Address <> cell.Address And _
(nextCell.Row > cell.Row Or _
(nextCell.Row = cell.Row And nextCell.Column > cell.Column)) Then

intNextSheet = intCurSheet 'Update the next Worksheet's index
NextCellExists = True
'If not foud
Else
'Keep searching in the next Sheet
If intNextSheet < UBound(Arr) Then
intNextSheet = intNextSheet + 1
If NextCellInNextSheet Then NextCellExists = True
Else
ufmSearch.btnNext.Enabled = False
End If
End If
End With
End Function
Function NextCellInNextSheet() As Boolean
'---------------------------------------
'Check rest of sheets for next occurence
'---------------------------------------
Dim I As Integer
For I = intNextSheet To UBound(Arr)
With Worksheets(Arr(I))
Set nextCell = .Cells.Find(What:=ufmSearch.txtSearch.Text, _
After:=.Cells(.Rows.Count, .Columns.Count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not nextCell Is Nothing Then Exit For
End With
Next 'I
'If found
If Not nextCell Is Nothing Then
intNextSheet = I 'Update the next Worksheet's index
NextCellInNextSheet = True
End If
End Function
Function PreviousCellExists(ByVal cell As Range) As Boolean
'----------------------------------------
'Check current Sheet for previous cell.
'If not found move to previous Sheet.
'If found store the Sheet's index.
'----------------------------------------
With Worksheets(Arr(intCurSheet))
Set prevCell = .Cells.Find(What:=ufmSearch.txtSearch.Text, After:=cell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False)
'If found
If Not prevCell Is Nothing And prevCell.Address <> cell.Address And _
(prevCell.Row < cell.Row Or _
(prevCell.Row = cell.Row And prevCell.Column < cell.Column)) Then

intPrevSheet = intCurSheet 'Update the previous Worksheet's index
PreviousCellExists = True
'If not foud
Else
'Keep searching in the previous Sheet
If intPrevSheet > LBound(Arr) Then
intPrevSheet = intPrevSheet - 1
If PreviousCellInPreviousSheet Then PreviousCellExists = True
Else
ufmSearch.btnPrevious.Enabled = False
End If
End If
End With
End Function
Function PreviousCellInPreviousSheet() As Boolean
'---------------------------------------
'Check rest of sheets for previous occurence
'---------------------------------------
Dim I As Integer
For I = intPrevSheet To LBound(Arr) Step -1
With Worksheets(Arr(I))
Set prevCell = .Cells.Find(What:=ufmSearch.txtSearch.Text, After:=.Range("A1"), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False)
If Not prevCell Is Nothing Then Exit For
End With
Next 'I
'If found
If Not prevCell Is Nothing Then
intPrevSheet = I 'Update the next Worksheet's index
PreviousCellInPreviousSheet = True
End If
End Function
Sub ResetCellColor()
on error resume next
If Not curCell Is Nothing Then curCell.Interior.ColorIndex = lastColor
End Sub
[/vba]

[tstav]

Humble apologies to all of you who may have tried the code of post #12. I just noticed that I said "press Ctrl+Shift+F" when I meant "Ctrl+Alt+F" (as you can see in the code............................)

[mdmackillop]

This will search a specific colum on each sheet and return found locations to an index sheet
http://vbaexpress.com/kb/getarticle.php?kb_id=780

[Dodders]

Hi Guys,

Thanks for all your help. I've persisted with your suggestions and have finally got it to work.

Thanks again to everyone who has helped.

Simon