Search for text in multiple textboxes.

[VeeDubb65]

Short version: I need help figuring out a way to search for text within a huge number of textboxes.

Long version: I've created an excell file that uses more textboxes and VBA than actual spreadsheet functionality for use a shift log by one of the departments at my company.

I have VBA scripts set up to automatically create new tabs for each day as needed, and the tabs show up ready to use with textboxes where employees types notes about their shift that will be read by coworkers on other shifts. The tabs are automatically named with the date in the format ddd-mm-yy

There are also scripts set up that automatically delete tabs that are more than 30 days old beforeclose.

With 30 tabs and 6 textboxes per tab, there are 180 textboxes. I need a way to allow my users to search for any text string they enter, have it search every textbox on every tab, and return a list of tabs that contain that text.

I'm good with all of the forms and user interface stuff, but I have yet to find a way to loop through every textbox in the file and check for matching text. I should also point out that they won't be searching for the full contents of the textboxes. A user might make an entry that says, "John Doe, card number 500000, was in today complaining about xyz. I told offered him abc as compensation." I need another user to be able to search for "500000" or "Doe" and find out what tabs (if any) have that text somewhere in a textbox.

Guidance?

 

[GTO]

Hi VeeDubb,

Maybe something like:

Option Explicit
    
Sub FindPartial()
Dim wks             As Worksheet
Dim colTextBoxes    As Collection
Dim TBox            As OLEObject
Dim Counter         As Long
Dim MsgText         As String
Dim LookFor         As Variant
    
    LookFor = Application.InputBox("Enter string to look for, or pick cell with like data", "", , , , , , 2)
    Set colTextBoxes = New Collection
    
    For Each wks In ThisWorkbook.Worksheets
        For Each TBox In wks.OLEObjects
            If TypeName(TBox.Object) = "TextBox" Then
                If InStr(1, TBox.Object.Value, LookFor, vbTextCompare) Then
                    colTextBoxes.Add Item:=TBox, Key:=TBox.Parent.Name & "." & TBox.Name
                End If
            End If
        Next
    Next
    
    If colTextBoxes.Count = 0 Then
        MsgText = "No Matches"
    Else
        MsgText = "Match locations----------------------------------------" & vbCrLf & _
                  "Sheet:" & vbTab & vbTab & "TextBox:" & vbTab & vbTab & "Value:" & vbCrLf
        
        For Counter = 1 To colTextBoxes.Count
            MsgText = MsgText & _
                      colTextBoxes(Counter).Parent.Name & vbTab & vbTab & _
                      colTextBoxes(Counter).Name & vbTab & vbTab & _
                      colTextBoxes(Counter).Object.Value & vbCrLf
        Next
        MsgText = Left(MsgText, Len(MsgText) - 2)
    End If
    
    MsgBox MsgText, vbInformation, vbNullString
End Sub

Hope that helps,

Mark

 

[VeeDubb65]

First of all, WOW, and THANKS. That works almost perfectly.

The small issue is that I didn't differentiate here. The Textboxes I'm using are drawing using the insert>shapes menu, rather than activeX textboxes. I tried inserting a couple of activeX textboxes, and it certainly does work there.

So, what I need to do is either modify it to work with boxes drawn with shapes, or get my textboxes to use bulletted lists, because they'll be ticked if that goes away.


Other than that, your macro is perfect, and I can easily tweak the details to make it suit my needs.

 

[GTO]

You are very welcome. This is along the same lines, but using a Shapes version of a Textbox. Not super-well tested, but appears to work.

Sub FindPartial_InShapes()
Dim wks             As Worksheet
Dim colTextBoxes    As Collection
Dim TBox            As Shape
Dim Counter         As Long
Dim MsgText         As String
Dim LookFor         As Variant
    
    LookFor = Application.InputBox("Enter string to look for, or pick cell with like data", "", , , , , , 2)
    Set colTextBoxes = New Collection
    
    For Each wks In ThisWorkbook.Worksheets
        
        For Each TBox In wks.Shapes
            If TBox.Type = &H11 Then    'msoTextBox
                If InStr(1, TBox.TextFrame2.TextRange.Text, LookFor, vbTextCompare) Then
                    colTextBoxes.Add Item:=TBox, Key:=TBox.Parent.Name & "." & TBox.Name
                End If
            End If
        Next
    Next
    
    If colTextBoxes.Count = 0 Then
        MsgText = "No Matches"
    Else
        MsgText = "Match locations----------------------------------------" & vbCrLf & _
                  "Sheet:" & vbTab & vbTab & "TextBox:" & vbTab & vbTab & "Value:" & vbCrLf
        
        For Counter = 1 To colTextBoxes.Count
            MsgText = MsgText & _
                      colTextBoxes(Counter).Parent.Name & vbTab & vbTab & _
                      colTextBoxes(Counter).Name & vbTab & vbTab & _
                      colTextBoxes(Counter).TextFrame2.TextRange.Text & vbCrLf
        Next
        MsgText = Left(MsgText, Len(MsgText) - 2)
    End If
    
    MsgBox MsgText, vbInformation, vbNullString
End Sub

 

[VeeDubb65]

Thank you again.

I had tried a very similar modification, but I got lost in the syntax for this part:

        For Each TBox In wks.Shapes
            If TBox.Type = &H11 Then    'msoTextBox
                If InStr(1, TBox.TextFrame2.TextRange.Text, LookFor, vbTextCompare) Then
                    colTextBoxes.Add Item:=TBox, Key:=TBox.Parent.Name & "." & TBox.Name
                End If
            End If
        Next

I've now tested this extensively, and I can't find a single problem with it that applies to me. it grabs text from multiple textboxes on multiple sheets, and required only minimal changes for my needs. Down the road, I may try to execute this through a custom form and make it so users can navigate right to the results with a click, but for now, this is more than enough.


The one small problem I found (which doesn't apply to me at all, but may be important if anyone else needs something like this) is that the 3rd field of each entry that gets returned, returns some of the text from the textbox in question, which would be a good thing if it was the same line of text that contained the search query, but it only returns the first line of text. I don't need that field at all, so I've simply removed the vb that reports it. All of my tabs are named with a date in the format mmm-dd-yy, and all of my textboxes are named with meaningful names (Events, Guest Issues, Staffing, etc) so just returning the tab name and the name of the textbox is all they need.

 

[GTO]

Hi VeeDub,

...The one small problem I found ...is that the 3rd field of each entry that gets returned, returns some of the text from the textbox in question, ...but it only returns the first line of text.

It appears TextFrame2 (and thus .TextRange and .Text) were added sometime after Excel 2000, which is what I'm in now (at home). So no current ability to test, but by memory, I believe I tested against short strings only. Oops!

If you have time to test, try:

Sub FindPartial_InShapes_02()
Dim wks             As Worksheet
Dim colTextBoxes    As Collection
Dim TBox            As Shape
Dim Counter         As Long
Dim MsgText         As String
Dim LookFor         As Variant
    
    LookFor = Application.InputBox("Enter string to look for, or pick cell with like data", "", , , , , , 2)
    Set colTextBoxes = New Collection
    
    For Each wks In ThisWorkbook.Worksheets
        
        For Each TBox In wks.Shapes
            If TBox.Type = &H11 Then    'msoTextBox
                If InStr(1, TBox.TextFrame.Characters.Text, LookFor, vbTextCompare) Then
                
                    colTextBoxes.Add Item:=TBox, Key:=TBox.Parent.Name & "." & TBox.Name
                End If
            End If
        Next
    Next
    
    If colTextBoxes.Count = 0 Then
        MsgText = "No Matches"
    Else
        MsgText = "Match locations----------------------------------------" & vbCrLf
        
        For Counter = 1 To colTextBoxes.Count
            MsgText = MsgText & _
                      "Sheet:" & vbTab & colTextBoxes(Counter).Parent.Name & vbCrLf & _
                      "TextBox:" & vbTab & colTextBoxes(Counter).Name & vbCrLf & _
                      "Text:" & vbTab & _
                      colTextBoxes(Counter).TextFrame.Characters.Text & vbCrLf
        Next
    End If
    MsgBox Left(MsgText, Len(MsgText) - 2), vbInformation, vbNullString
End Sub

As you'll note, I tried TBox.TextFrame.Characters.Text instead. This seems to work on my end. If you do test, would you mention what Excel version you are in?

Hope that's better. As you said, you do not need to return the text currently, but of course we should be able to. Unfortunately, I am far from being "all that and a bag of chips" when it comes to Shapes...

Mark

 

[VeeDubb65]

That does seem to work just fine. The formatting could use some polish, but structurally I'd say that it's excellent.

As for versions, I'm running Office 2010.

 

[GTO]

Thank you for the answer as to ver. I was hoping it would be suitable for 2000 and therafter

If by formatting, you mean the msgbox, yes - that was just rudimentary for the example. I would definitely use a userform.

Mark

 

[VeeDubb65]

I would definitely use a userform.

Absolutely.

Here's what I came up with:

Option Explicit
Public SearchResults As String
 
Sub FindPartial_InShapes()
Dim wks             As Worksheet
Dim colTextBoxes    As Collection
Dim TBox            As Shape
Dim Counter         As Long
Dim MsgText         As String
Dim LookFor         As Variant
    LookFor = Application.InputBox("Find:", "", , , , , , 2)
    Set colTextBoxes = New Collection
    For Each wks In ThisWorkbook.Worksheets
 
        For Each TBox In wks.Shapes
            If TBox.Type = &H11 Then    'msoTextBox
                If InStr(1, TBox.TextFrame2.TextRange.Text, LookFor, vbTextCompare) Then
                    colTextBoxes.Add Item:=TBox, Key:=TBox.Parent.Name & "." & TBox.Name
                End If
            End If
        Next
    Next
 
    If colTextBoxes.Count = 0 Then
        MsgText = "No Matches"
        Exit Sub
    Else
        MsgText = "Entries matching: " & LookFor & vbNewLine & vbCrLf & _
                  "Date:" & vbTab & vbTab & "Section:" & vbNewLine & vbCrLf
        For Counter = 1 To colTextBoxes.Count
            MsgText = MsgText & _
                      colTextBoxes(Counter).Parent.Name & vbTab & _
                      colTextBoxes(Counter).Name & vbTab & vbCrLf
        Next
        MsgText = Left(MsgText, Len(MsgText) - 2)
    End If
    SearchResults = MsgText
    HostSearchResults.Show vbModeless
End Sub

The user form I put together just has a calendar and a textbox. For the textbox options I set multiline and enter key behavior both to True, and I enabled a vertical scrollbar as well. Then I used the code below:

Private Sub UserForm_Initialize()
'On open, sets the calendar date to today's date.
    Me.Calendar1 = Date
'I named the textbox where the results are printed "Results"
    Me.Results.Text = SearchResults
End Sub
 
Private Sub Calendar1_Click()
    Application.ScreenUpdating = False
    scClick = Format(Calendar1.Value, "mmm-dd-yy")
    On Error GoTo MakeSheet
    Sheets(scClick).Select
    Application.ScreenUpdating = True
    Exit Sub
MakeSheet:
 
    ActiveWorkbook.Sheets("Master").Copy _
       After:=ActiveWorkbook.Sheets("Master")
    ActiveSheet.Name = scClick
End Sub

The user can scroll through the search results, make notes in the textbox if needed, and use the calendar to select the tab they want to go to. (again, all of my tabs are named for dates in mmm-dd-yy format. Also, they need the calendar to navigate to the tabs because I have used VBA to lock the users out of the regular tab bar)

With the vbModeless I used in the form call, the user can also continue to interact with the workbook while the form is open. Formatting is much less of an issue because I'm not using the text property, just the parent and name. The minor changes I made to the macro were enough for it to all show up nice and pretty in my form.


Once again, thank you VERY much for your help. 80% of this I already knew how to do, but I was utterly stuck on looping through the textboxes and I'd have spent a month trying to figure it out on my own.