Consulting

Results 1 to 15 of 15

Thread: Find Multiple Text in Single Cell - Make Bold

  1. #1

    Smile Find Multiple Text in Single Cell - Make Bold

    Dear Experts,

    I have used the following macro to BOLD a single text string within a cell and it works fine for a single string:

    [VBA]Sub MakeWordBold()
    Dim strSearch As String, searchRng As Range, i As Long, cel As Range
    Set searchRng = Range("A1:A10")
    strSearch = InputBox("Please enter the text to make bold:", "Bold Text")
    If strSearch = "" Then Exit Sub
    For Each cel In searchRng
    With cel
    .Font.Bold = False
    For i = 1 To Len(.Text) - Len(strSearch) Step 1
    If Mid(.Text, i, Len(strSearch)) = strSearch Then
    .Characters(i, Len(strSearch)).Font.Bold = True
    End If
    Next i
    End With
    Next cel
    End Sub[/VBA]

    The Macro above will do the following:
    Example[dog]: "the dog is black" becomes "the dog is black"

    Required: Can you adapt/create a macro to BOLD multiple strings within a single cell???

    Example[dog, black]: "the dog is black"

    Many thanks!!!
    C
    Last edited by Bob Phillips; 08-22-2012 at 02:50 AM. Reason: Added VBA tags

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [VBA]Sub MakeWordBold()
    Dim strSearch As String
    Dim arySearch As Variant
    Dim searchRng As Range
    Dim cel As Range
    Dim i As Long, ii As Long

    Set searchRng = Range("A1:A10")
    strSearch = InputBox("Please enter the text to make bold as a comma delimited list (abc,xyz) - no spaces:", "Bold Text")
    If strSearch = "" Then Exit Sub
    arySearch = Split(strSearch, ",")
    For Each cel In searchRng

    With cel

    .Font.Bold = False
    For ii = LBound(arySearch) To UBound(arySearch)

    i = InStr(cel.Value, arySearch(ii))
    If i > 0 Then

    .Characters(i, Len(arySearch(ii))).Font.Bold = True
    End If
    Next ii
    End With
    Next cel
    End Sub
    [/VBA]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3

    Thanks!

    Pure Genius....

    Thanks!

  4. #4

    Follow-Up

    Quick Question:

    How would I change this to always look for the same words???

    The text box only allows for 256 characters, and I need more than that...

    So my thinking is, can I put the complete lookup string into the macro.

    Thanks,

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    A tweak of xld's code:[vba]Sub MakeWordBold()
    'http://www.vbaexpress.com/forum/showthread.php?t=43393
    Dim strSearch As String
    Dim arySearch As Variant
    Dim searchRng As Range
    Dim cel As Range
    Dim i As Long, ii As Long
    Set searchRng = Range("A1:A10")
    strSearch = "black,dog" '<<<<<<<<<<<<< adjust this.
    arySearch = Split(strSearch, ",")
    For Each cel In searchRng
    With cel
    .Font.Bold = False
    For ii = LBound(arySearch) To UBound(arySearch)
    If Len(arySearch(ii)) > 0 Then 'just in case there's just a single comma or there are two commas next to each other in arySearch
    i = InStr(cel.Value, arySearch(ii))
    StartPosn = 1
    While i > 0
    .Characters(i, Len(arySearch(ii))).Font.Bold = True
    StartPosn = i + 1
    i = InStr(StartPosn, cel.Value, arySearch(ii))
    Wend
    End If
    Next ii
    End With
    Next cel
    End Sub
    [/vba]Two tweaks in fact, one to hard code the words, the second to highlight all instances of a string should there me more than one in any cell, so with the example above:
    the dog is black, as black as black can be, but not all dogs are black
    becomes:
    the dog is black, as black as black can be, but not all dogs are black
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    seems to crash at line 15:
    "StartPosn = 1"....

    Any ideas?

    Thanks,

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    Quote Originally Posted by jonesyuk
    seems to crash at line 15:
    "StartPosn = 1"....

    Any ideas?

    Thanks,
    With what message?
    It could be (if you've got Option Explicit at the top of the code module) that you need to add:
    [VBA]Dim StartPosn as Long[/VBA]
    with all the other Dim statements at the top of the macro.

    Note that I've corrected String to Long since originally posting.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    In this version I've scrubbed StartPosn altogether:[VBA]Sub MakeWordBold2()
    'http://www.vbaexpress.com/forum/showthread.php?t=43393
    Dim strSearch As String
    Dim arySearch As Variant
    Dim searchRng As Range
    Dim cel As Range
    Dim i As Long, ii As Long
    Set searchRng = Range("A1:A10")
    strSearch = "black,dog"
    arySearch = Split(strSearch, ",")
    For Each cel In searchRng
    With cel
    .Font.Bold = False
    For ii = LBound(arySearch) To UBound(arySearch)
    If Len(arySearch(ii)) > 0 Then
    i = InStr(cel.Value, arySearch(ii))
    While i > 0
    .Characters(i, Len(arySearch(ii))).Font.Bold = True
    i = i + 1
    i = InStr(i, cel.Value, arySearch(ii))
    Wend
    End If
    Next ii
    End With
    Next cel
    End Sub
    [/VBA]
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  9. #9
    fab, thanks so much...! It works great...

  10. #10
    Hi again.... as explained above, this macro from p45cal works perfectly. Is it possible to include a random value as well???

    Example: "Ingredients: €1k"

    The "€" symbol and the "k" will always surround the number, but the number will be different all the time, next month it may be €-2k

    So with the above macro, I have included "Ingredients:" in the code, and so when I run it, this will result in "Ingredients: €1k" (but note that the value is not bold)... I would like to end up with "Ingredients: €1k"

    Is it possible to update the above macro to include the values???

    Many thanks,

  11. #11
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    This is perfectly do-able but I'm not going to have time to answer this in the next few days.
    If you don't get a response here sooner rather than later (potential respondents seeing a thread with 11 messages will probably take it that the query's being dealt with), perhaps start a new thread with the subject like the current one but include 'using RegEx' in it - it may whet a savvy RegEx user's appetite for problem solving - and include a reference back to this thread (like: http://www.vbaexpress.com/forum/showthread.php?t=43393) too.

    Using Like could be another approach, but it's not as flexible as RegEx and it might be quite awkward to implement well.

    Make sure you state all the characters that could be included in the variable part - a dot for a decimal point, a minus sign etc.

    John Nurick has some good stuff on RegEx see VBA functions using regular expressions here: http://www.j.nurick.dial.pipex.com/Code/index.htm and here: http://www.j.nurick.dial.pipex.com/C...boutRegexp.htm
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  12. #12
    VBAX Mentor Teeroy's Avatar
    Joined
    Apr 2012
    Location
    Sydney, Australia
    Posts
    414
    Location
    It sounds like you may need Regular Expressions. I've used them in Python but not VBA. This link might help http://www.tmehta.com/regexp/ (sight unseen).

    A word of caution, actually a quote from a Python book (I'd cite it if I could remember ). "I have a problem... I know I'll use regular expressions. Now I have two problems." Test any regex work carefully on a sample before letting it loose; it can collect the craziest matches that you don't intend. It may not hurt if you're just formatting but I've had some "interesting" experiences with find and replace .

    Good luck.
    _________________________________________________________________________
    "In theory there is no difference between theory and practice. In practice there is." - Chuck Reid

    Any day you learn something new is a day not wasted.

  13. #13
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Quote Originally Posted by Jamie Zawinski
    Some people, when confronted with a problem, think "I know, I'll use Regular Expressions". Now they have two problems.
    Although generally attributed to Jamie in a Usenet posting, it is also originally attributed to Fredrik Lundh. There is a discussion here
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  14. #14
    VBAX Mentor Teeroy's Avatar
    Joined
    Apr 2012
    Location
    Sydney, Australia
    Posts
    414
    Location
    Thanks XLD . I didn't know the quote's origins were that old (in IT years that's ancient).

    BTW, even though I haven't had any problems posted on this forum, reading the code examples you've posted has helped myself (and others I'm sure) learn heaps. So thanks for all the time you invest.
    _________________________________________________________________________
    "In theory there is no difference between theory and practice. In practice there is." - Chuck Reid

    Any day you learn something new is a day not wasted.

  15. #15
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    It's a great quote isn't it, and it can be adapted to so many situations.

    I just love this one. It is so true and trying to explain this to senior management when we have deadline problems is just impossible -

    "What one programmer can do it one month, two programmers can do in two months" - Fred Brooks.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •