Make specific text bold in cells

[lebowski]

I have a list of text in Excel that I need to make bold; I also need to match entire cell contents for some text but not all.

So if I have the following text which I need to make bold within the cell:
text1
text2
text3
etc

And the following text which I need to make bold if it matches the entire cell content only:
textall1
textall2
textall3
etc.

I have the following code for matching within the cell:


Dim rCell As Range, sToFind As String, iSeek As Long

sToFind = "text1"

For Each rCell In Range("A1:A50")
iSeek = InStr(1, rCell.Value, sToFind)
Do While iSeek > 0
rCell.Characters(iSeek, Len(sToFind)).Font.Bold = True
iSeek = InStr(iSeek + 1, rCell.Value, sToFind)
Loop
Next

Is there a way to setup an array to prevent having to repeat the above code for text2, text3, etc?

Can the code be modified to match only the entire cell content for "textall1", "textall2", etc?

Would really appreciate help as I've hit a wall. Thanks.

[Yongle]

Try this amended version of your code to see if it answers the first part of your question
- amend the 5 in Dim Text(1 to 5) to reflect how many strings you are setting up
- amend the text from "apple" , "day" ..etc to reflect the text you are searching for




Sub Find_and_Bold()
Dim rCell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 5) As String
Dim i As Integer


Text(1) = "apple"
Text(2) = "day"
Text(3) = "keeps"
Text(4) = "doctor"
Text(5) = "away"


For i = LBound(Text) To UBound(Text)
For Each rCell In Range("A1:A50")
sToFind = Text(i)
iSeek = InStr(1, rCell.Value, sToFind)
Do While iSeek > 0
rCell.Characters(iSeek, Len(sToFind)).Font.Bold = True
iSeek = InStr(iSeek + 1, rCell.Value, sToFind)
Loop
Next rCell
Next i


End Sub

[Yongle]

If the above reply has satisfied part 1 of your question, insert this code just above "End Sub", amending array size and text strings as before.
Hopefully this will satisfy :
Can the code be modified to match only the entire cell content for "textall1", "textall2", etc?

Dim TextAll(1 To 5) As String
TextAll(1) = "bird"
TextAll(2) = "in"
TextAll(3) = "hand"
TextAll(4) = "better"
TextAll(5) = "bush"
For i = LBound(TextAll) To UBound(TextAll)
For Each rCell In Range("A1:A50")
If rCell.Value = TextAll(i) Then
rCell.Font.Bold = True
Else
End If
Next rCell
Next i

Note - matching is case sensitive. If that is not what you want, then a minor modification is required.

[lebowski]

Works a charm, thank you so much. Big help in how to construct these loops to avoid code duplication. Thanks again.


Try this amended version of your code to see if it answers the first part of your question
- amend the 5 in Dim Text(1 to 5) to reflect how many strings you are setting up
- amend the text from "apple" , "day" ..etc to reflect the text you are searching for




Sub Find_and_Bold()
Dim rCell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 5) As String
Dim i As Integer


Text(1) = "apple"
Text(2) = "day"
Text(3) = "keeps"
Text(4) = "doctor"
Text(5) = "away"


For i = LBound(Text) To UBound(Text)
For Each rCell In Range("A1:A50")
sToFind = Text(i)
iSeek = InStr(1, rCell.Value, sToFind)
Do While iSeek > 0
rCell.Characters(iSeek, Len(sToFind)).Font.Bold = True
iSeek = InStr(iSeek + 1, rCell.Value, sToFind)
Loop
Next rCell
Next i


End Sub

[lebowski]

Fantastic, works just as I need it to, matching whole cell only, thank you. Now I just need to run this from a Word macro so hopefully I'll be able to modify the code.



If the above reply has satisfied part 1 of your question, insert this code just above "End Sub", amending array size and text strings as before.
Hopefully this will satisfy :

Dim TextAll(1 To 5) As String
TextAll(1) = "bird"
TextAll(2) = "in"
TextAll(3) = "hand"
TextAll(4) = "better"
TextAll(5) = "bush"
For i = LBound(TextAll) To UBound(TextAll)
For Each rCell In Range("A1:A50")
If rCell.Value = TextAll(i) Then
rCell.Font.Bold = True
Else
End If
Next rCell
Next i

Note - matching is case sensitive. If that is not what you want, then a minor modification is required.

[Yongle]

lebowski (http://www.vbaexpress.com/forum/member.php?54982-lebowski) -
glad problem fixed. Please go to ThreadTools and mark this thread as solved. The other issue would be a new thread. Thanks