Excel

Create a custom "Worksheet Find" toolbar

Ease of Use

Easy

Version tested with

2002,2003 

Submitted by:

Killian

Description:

This article shows how to build a custom toolbar that replicates basic Find/Find Next functionality. 

Discussion:

Offers a convenient solution for users to do a simple Find/Find next on a worksheet from a toolbar rather than bringing up the native dialog. 

Code:

instructions for use 

			
 '##################
 'standard module code
 
Dim firstAddress As String, lastaddress As String 
Dim ctrlStatus As CommandBarButton 
Dim ctrlFN As CommandBarButton 
Dim ctrlText As CommandBarControl 
Dim iFindWhole As Integer 
 
Sub BuildToolBar() 
     'call from WorkBook_Open
     
    Dim TBar As CommandBar 
    Dim btnNew As CommandBarControl 
     
     'delete any existing instances of the toolbar
    DeleteToolbar 
     
     ' Add a new toolbar
    Set TBar = CommandBars.Add(Name:="Worksheet Find") 
    TBar.Visible = True 
     
     ' Add text control
    Set btnNew = TBar.Controls.Add(Type:=msoControlEdit) 
    With btnNew 
        .Caption = "Find..." 
        .TooltipText = "Enter search string..." 
        .Style = msoComboLabel 
        .OnAction = "FindText" 
    End With 
    Set ctrlText = btnNew 
     ' add a find next button
    Set btnNew = TBar.Controls.Add(Type:=msoControlButton) 
    With btnNew 
        .Caption = "Find &next" 
        .TooltipText = "Find next" 
        .Style = msoButtonCaption 
        .OnAction = "FindNext" 
        .Enabled = False 
    End With 
    Set ctrlFN = btnNew 
     ' add whole/part
    Set btnNew = TBar.Controls.Add(Type:=msoControlButton) 
    With btnNew 
         '.BeginGroup = True
        .Caption = "Match" 
        .TooltipText = "Match entire cell contents" 
        .Style = msoButtonIconAndCaption 
        .OnAction = "ToggleFindWhole" 
        iFindWhole = 1 
        .FaceId = 1907 
    End With 
     ' add a status button
    Set btnNew = TBar.Controls.Add(Type:=msoControlButton) 
    With btnNew 
        .Caption = "" 
        .TooltipText = "Result..." 
        .Style = msoButtonIconAndCaption 
        .Width = 240 
    End With 
    Set ctrlStatus = btnNew 
     
     'force the toolbar to 2 rows and lock
    With TBar 
        .Height = btnNew.Height * 3 
        .Protection = msoBarNoResize 
    End With 
     
    Set btnNew = Nothing 
    Set TBar = Nothing 
     
End Sub 
 
Sub DeleteToolbar() 
     'call from Workbook_BeforeClose
     
    Dim cb As CommandBar 
     
    For Each cb In CommandBars 
        If cb.Name = "Worksheet Find" Then 
            cb.Delete 
        End If 
    Next cb 
     
End Sub 
 
Sub FindText() 
     'excecute the first find
    Dim c As Range 
     
    Set c = ActiveSheet.Cells.Find(What:=ctrlText.Text, _ 
    LookIn:=xlValues, LookAt:=iFindWhole) 
    If Not c Is Nothing Then 
         'activate the found cell, capture address,
         'enable find next button, update status
        c.Activate 
        ctrlFN.Enabled = True 
        firstAddress = c.Address 
        lastaddress = c.Address 
        ctrlStatus.Caption = """" & ctrlText.Text & """" & " found at " & lastaddress 
        ctrlStatus.FaceId = 1087 
    Else 
         'disable Find next, clear addresses, update status
        ctrlFN.Enabled = False 
        firstAddress = "" 
        lastaddress = "" 
        ctrlStatus.Caption = """" & ctrlText.Text & """" & " not found" 
        ctrlStatus.FaceId = 1088 
    End If 
     
    Set c = Nothing 
     
End Sub 
 
Sub FindNext() 
     
    Dim c As Range 
     
    Set c = ActiveSheet.Cells.FindNext(ActiveSheet.Range(lastaddress)) 
    If c.Address <> firstAddress Then 
         'activate the found cell, update address and status
        c.Activate 
        lastaddress = c.Address 
        ctrlStatus.Caption = """" & ctrlText.Text & """" & " found at " & lastaddress 
        ctrlStatus.FaceId = 1087 
    Else 
         'disable Find next, clear addresses, update status
        c.Activate 
        ctrlFN.Enabled = False 
        firstAddress = "" 
        lastaddress = "" 
        ctrlStatus.Caption = """" & ctrlText.Text & """" & " - no more instances found" 
        ctrlText.Text = "" 
        ctrlStatus.FaceId = 1088 
    End If 
     
    Set c = Nothing 
     
End Sub 
 
Sub ToggleFindWhole() 
     
    If iFindWhole = 1 Then 
        iFindWhole = 2 
        CommandBars.ActionControl.FaceId = 0 
    Else 
        iFindWhole = 1 
        CommandBars.ActionControl.FaceId = 990 
    End If 
     
End Sub 
 
 'standard module code  - END
 '##################
 
 '##################
 'Workbook events
 
Private Sub Workbook_Open() 
    BuildToolBar 
End Sub 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    DeleteToolbar 
End Sub 
 
 'Workbook events - END
 '##################

How to use:

  1. Open the VBE in a blank workbook
  2. Insert a new standard module (Insert>Module) and paste in the code up to "'standard module code - END"
  3. Go to the WorkBook code module (Double click the "ThisWorkbook" item in the Project Explorer
  4. Paste in the code for the workbook events
  5. Save and close the workbook
 

Test the code:

  1. On opening the workbook the toolbar should be visible.
  2. The user can toggle "Match entire cell contents" the the "Match" button
  3. Enter a search sting in the toolbar's text control and press Enter to search.
  4. The result of the search should be displayed as the "Result" control's caption.
  5. If the search string is found, the "Find next" button is enabled - click this to find the next instance.
 

Sample File:

WorksheetFindToolbar.zip 12.53KB 

Approved by mdmackillop


This entry has been viewed 322 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2012 VBA Express