Finding text in a rectangle

Bakuryu

New Member
Joined
Feb 14, 2005
Messages
3
Hi, I was wondering if there was a way to find text in rectangles.
I got a big hierarchy with lots of rectangles with names in it and it would be very usefull if i could search for names.

Thanks in advance
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
Search for text in rectangles

Hi Bakuryu,

Give this code a try:

Dim FindTxtSave As String 'Last rectangle search text

Sub FindRecText()
FindRectangleText
End Sub

Sub FindRectangleText(Optional FindTxt As String = "")
'Searches all rectangles on the active sheet for text
Dim Sh As Shape
Dim iCh As Integer
Dim lCh As Integer
Dim answer As Variant
Dim FillSet As Boolean

If FindTxt = "" Then
FindTxt = InputBox("Enter find text", "Rectangle Text Search")
End If
If FindTxt = "" Then Exit Sub
lCh = Len(FindTxt)

For Each Sh In ActiveSheet.Shapes
If Sh.Type = msoTextBox Then
iCh = 1
FillSet = False
Do While True
iCh = InStr(iCh, Sh.TextFrame.Characters.Text, FindTxt)
If iCh = 0 Then Exit Do
If Not FillSet Then
Sh.Fill.ForeColor.RGB = NotRGB(Sh.Fill.ForeColor.RGB)
FillSet = True
End If
Beep
'highlight characters
With Sh.TextFrame.Characters(iCh, lCh)
.Font.Color = NotC(.Font.Color)
End With
iCh = iCh + 1
Loop
End If
Next Sh

FindTxtSave = FindTxt

End Sub

Sub ClearFind()
FindRectangleText FindTxtSave
End Sub

Function NotC(Cin As Variant) As Long
'Invert colorindex color and convert to RGB
If Cin = 0 Or Cin = Null Then
NotC = &HFFFFFF
Else
NotC = Not ActiveWorkbook.Colors(Cin)
NotC = NotC And &HFFFFFF
End If
End Function

Function NotRGB(Cin As Long) As Long
'Invert RGB color
NotRGB = Not Cin
NotRGB = NotRGB And &HFFFFFF
End Function

This code should be placed in a standard macro module. To do this, go to the VBE (keyboard Alt-TMV), insert a new macro module (Alt-IM), and paste this code into the Code pane.

The approach I used was to highlight all the text found. To do the find, run macro FindRecText. It will prompt you for the text you want to search for and will highlight the found text by reversing the color of the text--and to make sure it is visible it also reverses the fill color of the rectangles. Obviously, reversing black text to white in a rectangle containing white fill would make the text invisible--not a very effective way to highlight it. But reversing both text and fill ensures the found text is visible, even though it might make the other text invisible.

To un-highlight the previously found text, run the macro ClearFind.

I hope this does what you want.

Damon
 

Bakuryu

New Member
Joined
Feb 14, 2005
Messages
3
Hey Damon,

Thanks alot for replying.

In your code you used If Sh.Type = msoTextBox Then

But we're using Rectangles not textboxes.. do you know the Sh.Type name for rectangles?

Thanks in advance
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
If it's an Autoshape its type will be msoAutoShape and its AutoShapeType will be msoShapeRectangle if it's a rectangle.

Code:
Sub Test()
    Dim Sh As Shape
    For Each Sh In ActiveSheet.Shapes
        If Sh.Type = msoAutoShape Then
             If Sh.AutoShapeType = msoShapeRectangle Then
                MsgBox "Rectangle"
             End If
        End If
    Next Sh
End Sub
 

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239

ADVERTISEMENT

Hi again Bakuryu,

Were you able to incorporate Andrew's answer into my code? Let us know if any problems.

Damon


Thank you Andrew for helping out.
 

Bakuryu

New Member
Joined
Feb 14, 2005
Messages
3
Yes, it worked! Thanks alot guys.

Its almost perfect.. the only things needed extra is that it jumps to the highlighted box and not make it case-sensitive.. is that possible?

Thanks alot again your help is really appreciated!
 

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
Hi Bakuryu,

To make my search code case-insensitive, change

iCh = InStr(iCh, Sh.TextFrame.Characters.Text, FindTxt)

to

iCh = InStr(iCh, UCase(Sh.TextFrame.Characters.Text), UCase(FindTxt))

Regarding having the search find one occurrence at a time, it should be possible for the code to do this. Bit I don't believe it is possible with VBA to select text or place the cursor within a textbox, even though it can read and write the text. So if your intent is to have it work like a Find in MS Word, such that text found in textboxes is highlighted and selected, I think you are out of luck. :cry:
 

Watch MrExcel Video

Forum statistics

Threads
1,123,258
Messages
5,600,568
Members
414,389
Latest member
MarkElla

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top