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!

 

[amaneta]

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.

GENIUS!! It works perfectly now! Thank you Rick! And thanks so much to everyone who responded. You've helped me a lot and I really appreciate it!

 

[Peter_SSs]

Peter...this works! THANK YOU!!

You are welcome.

.. and thanks to Rick for the 'Spanish tweak'.

 

[abramo]

To anybody reading this, greetings.

I wonder whether a new thread should be started, or not, regarding modification of @Peter_SSs at #4 - to satisfy a different end requirement.

In particular, instead of adding tags to the full UPPERCASE elements as detected by the current vba to just return said detected elements *converted in proper case*.

Any solutions much appreciated as usual, needless to say

 

[Peter_SSs]

To anybody reading this, greetings.

I wonder whether a new thread should be started, or not, regarding modification of @Peter_SSs at #4 - to satisfy a different end requirement.

In particular, instead of adding tags to the full UPPERCASE elements as detected by the current vba to just return said detected elements *converted in proper case*.

Any solutions much appreciated as usual, needless to say

Could we have a small sample data and expected results? Or perhaps just the expected results if the sample data was as in column A of post 4?

 

[abramo]

Hello @Peter_SSs - and thanks.
Example of text in cell:

BEAUTIFUL DAY is it NOT. We are GOING to have  a nice TIME.
[/COLOR][COLOR=#574123]

Result:

Beautiful Day is it Not. We are Going to have  a nice Time.
[/COLOR][COLOR=#574123]

I have come to this, works fine, perhaps can do with tidying up??:

[/COLOR]Sub ConvertUppercaseWordsToProper()


Dim ToReplace As Object
For Each c In Selection.Cells


 'This generates a list of items that match.
 
 With CreateObject("VBScript.RegExp")


  .Global = True
  .Pattern = "\b([A-Z][A-Z ,'\-]*[A-Z])\b"
  Set ToReplace = .Execute(c.Value)
  
End With


'This converts to Proper case the item


 Dim ProperCaseVersion As String
 Dim ItemCt As Integer
 For ItemCt = 0 To ToReplace.Count - 1
 ProperCaseVersion = StrConv((ToReplace.Item(ItemCt)), vbProperCase)


'This replaces the item with the Proper case version
 
With CreateObject("VBScript.RegExp")


  .Global = True
  .Pattern = ToReplace.Item(ItemCt)
  c.Value = .Replace(c.Value, ProperCaseVersion)
  
  End With
  
  Next ItemCt
  
Next c


End Sub

Alternatively, leaving any items smaller than 3 characters unchanged:
Example:

BEAUTIFUL DAY is it NOT. We are GOING to have  a nice TIME.
[/COLOR][COLOR=#574123]

Result:

Beautiful DAY is it NOT. We are Going to have  a nice Time.
[/COLOR][COLOR=#574123]

Sub ConvertUppercaseWordsToProper()


Dim ToReplace As Object
For Each c In Selection.Cells


 'This generates a list of items that match.
 
 With CreateObject("VBScript.RegExp")


  .Global = True
  .Pattern = "\b([A-Z][A-Z ,'\-]*[A-Z])\b"
  Set ToReplace = .Execute(c.Value)
  
End With


'This converts to Proper case the item


 Dim ProperCaseVersion As String
 Dim ItemCt As Integer
 For ItemCt = 0 To ToReplace.Count - 1
 ProperCaseVersion = StrConv((ToReplace.Item(ItemCt)), vbProperCase)


'This replaces the item with the Proper case version
 
With CreateObject("VBScript.RegExp")


  .Global = True
  .Pattern = ToReplace.Item(ItemCt)
  If Len(c.Value) > 3 Then c.Value = .Replace(c.Value, ProperCaseVersion)
  
  End With
  
  Next ItemCt
  
Next c


End Sub

Comment? Faster & more efficient?

Thanks!

.

 

[abramo]

Nah! alternative version "leaving any items smaller than 3 characters unchanged" does not really work (embarrassed!)
Any help with that?
Thanks!

.

 

[abramo]

Meh! how silly of me, obvious mistake corrected - here is an alternative version "leaving any items smaller than 3 characters unchanged" that does work!

[/COLOR][/COLOR]Sub ConvertUppercaseWordsToProper()


Dim ToReplace As Object
For Each c In Selection.Cells


 'This generates a list of items that match.
 
 With CreateObject("VBScript.RegExp")


  .Global = True
  .Pattern = "\b([A-Z][A-Z ,'\-]*[A-Z])\b"
  Set ToReplace = .Execute(c.Value)
  
End With


'This converts to Proper case the item


 Dim ProperCaseVersion As String
 Dim ItemCt As Integer
 For ItemCt = 0 To ToReplace.Count - 1
 ProperCaseVersion = StrConv((ToReplace.Item(ItemCt)), vbProperCase)


'This replaces the item with the Proper case version
 
With CreateObject("VBScript.RegExp")


  .Global = True
  .Pattern = ToReplace.Item(ItemCt)
  If Len(ProperCaseVersion) > 3 Then c.Value = .Replace(c.Value, ProperCaseVersion)
  
  End With
  
  Next ItemCt
  
Next c


End Sub

Even so, I was hoping to more tidy & efficient code.
Any ideas?

Thanks!

 

[abramo]

Not really - the alternative version "leaving any items smaller than 3 characters unchanged" does not work as required. Sorry!
Confused, no idea.

.

 

[abramo]

Any help appreciated.
.

 

[Peter_SSs]

Comment? Faster & more efficient?

In my mind the code below is a bit 'neater' & it should be a bit faster/more efficient though you probably will not notice unless there is a lot of data to process.

My main comment is that this sort of string manipulation can be extremely difficult to cover all bases.

As an example, your code converts
ANNA SMITH-JONES arrived yesterday
to
Anna Smith-jones arrived yesterday

I suspect that you wouldn't want that "J" converted to lower case?

We could change the pattern so that any upper case letter immediately after a word boundary or certain other characters remained as upper case. That would help with the "J" in SMITH-JONES to give Smith-Jones and the "C" in JAMES O'CONNOR to give James O'Connor
However, that O'Connor example also brings a problem if you have a apostrophe like this: JIM'S where I doubt you would want Jim'S returned.

In any case, this is what I came up with for the equivalent of your first code (that is, not excluding short words).
Note also that at the moment, my code writes the results in the next column to the right so that it is easy to compare result with original. Eventually you could remove the blue code to over-write the original data.
This code still converts SMITH-JONES to Smith-jones but we can look at that later if required.

Sub ConvertUppercaseWordsToProper_v2()
  Dim RX As Object, ToReplace As Object
  Dim a As Variant, itm As Variant
  Dim ProperCaseVersion As String
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "\b([A-Z][A-Z,'\-]*[A-Z])\b"
  With Selection
    a = .Value
    For i = 1 To UBound(a)
      ProperCaseVersion = a(i, 1)
      Set ToReplace = RX.Execute(ProperCaseVersion)
      For Each itm In ToReplace
        ProperCaseVersion = Replace(ProperCaseVersion, itm, StrConv(itm, vbProperCase), 1, -1, 0)
      Next itm
      a(i, 1) = ProperCaseVersion
    Next i
    .Offset(, 1).Value = a
  End With
End Sub

Sample data and code results.

Excel Workbook
	A	B
1	The fish is NOT allowed to swim in the water AFTER SUNSET.	The fish is Not allowed to swim in the water After Sunset.
2	ANNA SMITH-JONES arrived yesterday	Anna Smith-jones arrived yesterday
3	This is JIM'S book	This is Jim'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 look Carefully, You Will see An insect.
7	Part of a word in uPPer case does not get converted	Part of a word in uPPer case does not get converted
Convert case

To exclude words of 3 characters or less, just change the Pattern to

<del>RX.Pattern = "\b([A-Z][A-Z,'\-]*[A-Z])\b"</del>
RX.Pattern = "\b([A-Z][A-Z,'\-]{2,}[A-Z])\b"

Sample data and code results.

Excel Workbook
	A	B
1	The fish is NOT allowed to swim in the water AFTER SUNSET.	The fish is NOT allowed to swim in the water After Sunset.
2	ANNA SMITH-JONES arrived yesterday	Anna Smith-jones arrived yesterday
3	This is JIM'S book	This is Jim'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 look Carefully, YOU Will see AN insect.
7	Part of a word in uPPer case does not get converted	Part of a word in uPPer case does not get converted
Convert case

My other comment is that I am not a fan of using 'Selection' as the basis of what to process. If the data is in column A, I would prefer something like this

<del>With Selection</del>
With Range("A1", Range("A" & Rows.Count).End(xlUp))