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

[amaneta]

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]

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.

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.

 

[Jaamie]

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.

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]

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.

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
	A	B
1	The fish is NOT allowed to swim in the water AFTER SUNSET.	The fish isNOT allowed to swim in the waterAFTER SUNSET.
2	ANNA SMITH-JONES arrived yesterday	ANNA SMITH-JONES arrived yesterday
3	This is JIM'S book	This isJIM'S book
4
5	No upper case words here.	No upper case words here.
6	If you look CAREFULLY, YOU WILL see AN insect.	If you lookCAREFULLY, YOU WILL seeAN insect.
7	Part of a word in uPPer case does not get tags	Part of a word in uPPer case does not get tags
Sheet1

 

[amaneta]

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:

[TABLE="width: 200, align: left"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]1004[/TD]
[TD]what color is the sun?[/TD]
[TD]green[/TD]
[TD]blue[/TD]
[TD]yellow[/TD]
[TD]black[/TD]
[/TR]
</tbody>[/TABLE]








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]

Wow! Thank you Jaamie! You go! I'll give this a try and post back soon.

 

[amaneta]

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]

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]

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]

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.