Excel macro to find words in all caps then surround them in an html tag (e.g., <b> and </b>

amaneta

New Member
Joined
Aug 17, 2017
Messages
6
Hello!

I need an Excel macro that finds words or phrases in uppercase, then surrounds them with the html tags for bold. The uppercase words can have as few as 2 letters like "NO", and there can be more than 1 word in uppercase, in which case I want the tags to surround all uppercase words that are next to each other.

For example:

"The fish is NOT allowed to swim in the water AFTER SUNSET." should be changed to "The fish is <b>NOT</b> allowed to swim in the water <b>AFTER SUNSET</b>."

I have to add the tags so that when I import the excel file into another application, it recognizes the formatting.

Any help is greatly appreciated!
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,429
Hi amaneta,

You did not give a lot of information to work with. That said, if your sentence was in Cell A1, this would return your sentence with tags to cell A2. The requirement it does not meet is if there are two consecutive words. Although I have not worked with HTML for a long time, I see no reason why you application would not pick up the bold tags on two consecutive words with two sets of tags.

Code:
Sub boldtest()


    Dim wrd() As String, i As Integer
    Dim w As String
    Dim pd As String
    Dim dot As Boolean
    wrd = Split(Range("A1"), " ")
    If Right(wrd(UBound(wrd)), 1) = "." Then
        dot = True
        pd = wrd(UBound(wrd))
        wrd(UBound(wrd)) = Left(pd, Len(pd) - 1)
    End If
    For i = LBound(wrd) To UBound(wrd)
        If wrd(i) = UCase(wrd(i)) Then
            [COLOR=#ff0000]wrd(i) = " < b > [B] [B]" & wrd(i) & " < / b > [/B] [/B]"[/COLOR]
        End If
        w = w & " " & wrd(i)
    Next
    'End If
    w = Mid(w, 2)
    If dot Then w = w & "."
    Range("A2") = w


End Sub
Please note the line in red may have to be edited by you, due to the quirks of posting with that style bracket.

I hope this helps.
 
Last edited:

Jaamie

Board Regular
Joined
Apr 16, 2003
Messages
199
I have written a little macro to do what you want. I can send you a little Excel file if you want and if we can figure out how I do that.
This macro reads an Input Phrase from cell(10,1) of a worksheet. Then converts it to be internet ready and places the out phrase in
cell(3,1). Oh! by the way I am 76 and learned basic many years ago. Hopefully this will give you the concept even though others would do it differently.

Code:
Sub InternetReadyMac()

    Rows("1:3").Select: Selection.Clear    'Clear Output area
    CapAVal = 65: CapZVal = 90              'Ascii values for Capital A and Z
    'Click on Help and search for Ascii Character Set to see all the 0-127 values
    AllCapFlag = True                      'Stays True if the word is all Caps
    Cells(10, 1).Select: InPhrase$ = ActiveCell 'Get the phrase
    LastChar$ = Right(InPhrase$, 1)        'add a space if last word ends in a letter
    If InStr(".,;: ", LastChar$) = 0 Then InPhrase$ = InPhrase$ + " "
    L = Len(InPhrase$)
    OutPhrase$ = "": OutWord$ = ""          'Clear OutPhrase$ and OutWord$
    For J = 1 To L
      A$ = Mid(InPhrase$, J, 1)             'Take character by character
      Cells(1, J).Select: ActiveCell = A$   'Print character in row 1
      AscVal = Asc(A$)                      'find the ascii value
      Cells(2, J).Select: ActiveCell = AscVal  'Print it in row 2
      If InStr(".,;: ", A$) = 0 Then         'is it an end of word character
                                             'No
        If AscVal < CapAVal Or AscVal > CapZVal Then AllCapFlag = False  'Flag=False if not a Capital
        OutWord$ = OutWord$ + A$             'add char to word
      Else                                   'Yes
        If AllCapFlag = True Then OutWord$ = "<b>" + OutWord$ + "</b>"  'add the internet char if AllCapFlag still True
        OutPhrase$ = OutPhrase$ + OutWord$ + A$  'Add ltest word to OutPhrase
        OutWord$ = "": AllCapFlag = True         'Reset flags
     End If
    Next J
    Do                                        'eliminate any </b> <b> combinations
      L = Len(OutPhrase$)
      K = InStr(OutPhrase$, "</b> <b>")
      If K > 0 Then
        FirstPart$ = Left(OutPhrase$, K - 1)
        LastPart$ = Right(OutPhrase$, L - K - 7)
        OutPhrase$ = FirstPart$ + " " + LastPart$
      End If
    Loop Until K = 0
    Cells(3, 1).Select: ActiveCell = OutPhrase$
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,798
Office Version
365
Platform
Windows
Welcome to the MrExcel board!

A few more examples may have been useful to see if there is much variation in your data.
I have assumed ..
- Data is in column A, Output in column B (If you want to over-write the original data, just change the "B1" near the end of my code to "A1")
- If a section of upper case text contains spaces, commas, hyphens or apostrophes then the text should still be treated as a single section.

Code:
Sub Add_Tags()
  Dim a As Variant
  Dim i As Long
  
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\b([A-Z][A-Z ,'\-]*[A-Z])\b"
    For i = 1 To UBound(a)
      a(i, 1) = .Replace(a(i, 1), "<b>$1</b>")
    Next i
  End With
  Range("B1").Resize(UBound(a)).Value = a
End Sub
Sample data and results:

Excel Workbook
AB
1The fish is NOT allowed to swim in the water AFTER SUNSET.The fish isNOT allowed to swim in the waterAFTER SUNSET.
2ANNA SMITH-JONES arrived yesterdayANNA SMITH-JONES arrived yesterday
3This is JIM'S bookThis isJIM'S book
4
5No upper case words here.No upper case words here.
6If you look CAREFULLY, YOU WILL see AN insect.If you lookCAREFULLY, YOU WILL seeAN insect.
7Part of a word in uPPer case does not get tagsPart of a word in uPPer case does not get tags
Sheet1
 
Last edited:

amaneta

New Member
Joined
Aug 17, 2017
Messages
6
Thanks so much igold! I'm sorry I didn't give enough information. I'm working with a list of exam questions and answers. So, column A contains question numbers. Column B contains the questions. Columns C-F contain the answer options. Like this:

ABCDEF
1004what color is the sun?greenblueyellowblack

<tbody>
</tbody>








Anything in columns B-F can have words in all caps that need surrounding tags. I can have anywhere from 80 to 350 rows of questions/answers in a sheet.

I tried your macro and it works except that the word between the tags is missing.

If my information helps and you feel like tweaking your macro, I'd love the help! Thanks again!
 

amaneta

New Member
Joined
Aug 17, 2017
Messages
6
Thank you Peter_SSs! This looks like it's exactly what I need. I'll try it and post back soon! Thanks so much!
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,429
Thanks for the feedback. I think it is the way that the mechanics of the forum interpreted my post, it does not like open and close brackets (more than, less than). No problems, it appears as if Peter has given you a good code.
 

amaneta

New Member
Joined
Aug 17, 2017
Messages
6
Peter...this works! THANK YOU!!

I just have one small issue...the macro doesn't like accented caps, like in the Spanish language. Spanish is it, though, I promise! Thanks again for your help!
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,426
Office Version
2010
Platform
Windows
Peter...this works! THANK YOU!!

I just have one small issue...the macro doesn't like accented caps, like in the Spanish language. Spanish is it, though, I promise! Thanks again for your help!
It is 3:17 in the morning where Peter lives as I write this, so he won't be up to answer you for a few hours. I am rusty in my RegExp knowledge, but looking at this line from Peter's code...

.Pattern = "\b([A-Z][A-Z ,'\-]*[A-Z])\b"

but if you copy/paste each upper case Spanish letter (from some text source with them in it) that you want the code to recognize immediately after each Z in the code line, I think that should make the code work the way you want.
 

Forum statistics

Threads
1,078,393
Messages
5,339,926
Members
399,340
Latest member
JasonT903

Some videos you may like

This Week's Hot Topics

Top