Need a macro code to Cap the first letter of words in entire columns

[skyport]

I have been using a code that had been working fine but with the new data I'm using it has a flaw. Below is first the actual code I'm currently using followed by an explanation of the flaw I am now encountering.


Sub ConvertSelectionUpper_V4()
' hiker95, 08/27/2014, ME800718
Dim c As Range, s, i As Long, s2, h As String
Application.ScreenUpdating = False
With Selection
.Value = Evaluate("=if(len(" & .Address & "),substitute(proper(" & .Address & "),"" And "","" and ""),"""")")
.Columns.AutoFit
End With
For Each c In Selection
h = ""
If InStr(c, "'") Then
s = Split(Trim(c), " ")
For i = LBound(s) To UBound(s)
If InStr(s(i), "'") Then
s2 = Split(s(i), "'")
h = h & s2(0) & "'" & LCase(s2(1)) & " "
Else
h = h + s(i) & " "
End If
Next i
If Right(h, 1) = " " Then
h = Left(h, Len(h) - 1)
End If
c = h
End If
Next c
Application.ScreenUpdating = True
End Sub


The program above generally works fine. The problem in using the current code above is when a word in the sentence is actually composed of all Caps such as an MRI or CT scan at a hospital. In such a case, the MRI or CT are originally entered as all caps however when the above code is run, it does successfully and properly cap the first letter of each word in each cell however MRI consequently ends up as Mri and CT as Ct, which is the problem. If there was some way to adjust the program above or another way to cap the first letters of all the words without disturbing those such as MRI or CT and others that were already entered in as caps. I am hoping somebody has a solution for this.

 

[hiker95]

skyport,

Nice to hear from you again.

1. Can we see a screenshot of your actual raw data?

2. And, can we see a screenshot (manually formatted by you) of what the results should look like?


See reply #2 at the next link, if you want to show small screenshots.

http://www.mrexcel.com/forum/about-board/508133-attachments.html#post2507729


Or, you can post your workbook/worksheets to the following free site (sensitive data changed), and provide us with a link to your workbook:

https://dropbox.com

 

[skyport]

Hello there hiker, great to see you again as well. I was hoping you would show up for this one because as you can see in the first lines of the code that I am currently using, you are the one that actually made that great code and has done wonderfully for a long time. I think the easiest way to approach what I need is to just simply understand that your original code above works perfectly well with the exception that when it caps the first letter of each word it eliminates the caps that already exist in a word if they are not the first letter of the word. Once again, the primary examples would be things such as: MRI or CT, abbreviations for states such as; MD, NY etc. If there were a way that if the data has existing caps in place before the code is run, it would leave them in place untouched as it goes forward and caps the first letter of each word in the way it already does. The only other way I can think of overcoming the issue is to somehow have a list of words in a column on another worksheet that are exclusions that would tell the code to ignore those exceptions in the data when it comes across them where that could be a list to add things to such as MRI and CT, the states, as well as any other exceptions that come along in the future. Below is a precise sample of data:

MRI of left elbow without contrast, CT of the brain without contrast.

Using the above as an example, when I run the existing code it will properly and perfectly cap each word however MRI will be changed to Mri and CT will be changed to Ct. This is the only issue I am faced with is how to retain those two as MRI and CT and any other words or acronyms that are already entered into the data as all caps.

 

[hiker95]

skyport,

I will need to see examples of your NEW raw data strings, before, and, after, as per your reply #14 in your original thread, below:

http://www.mrexcel.com/forum/excel-...everyword-each-cell-column-macro-issue-2.html

The only other way I can think of overcoming the issue is to somehow have a list of words in a column on another worksheet that are exclusions that would tell the code to ignore those exceptions in the data when it comes across them where that could be a list to add things to such as MRI and CT, the states, as well as any other exceptions that come along in the future.

The above sounds like a good idea.

 

[skyport]

If that be the best way to go, can we try making the worksheet page named "words 2" column A to be where the excluded words would be listed?

Visual 1 - how data looks when first entered:

1	A	B	C	D	E
2	MRI of spine	,	John Smith, M.D.	,	12-16-2014
3	CT of brain W/O con	,	Jill Hill PA-C	,	12-20-2014
4	X-Ray and EKG	,	Clinic city view of NY	,	11-14-2015
5
6

<tbody>
</tbody>

Visual 2 - How it looks after current code runs:

1	A	B	C	D	E
2	Mri Of Spine	,	John Smith, M.D.	,	12-16-2014
3	Ct Of Brain W/o Con	,	Jill Hill Pa-c	,	12-20-2014
4	X-ray and Ekg	,	Clinic City View Of Ny	,	11-14-2015
5
6

<tbody>
</tbody>

Visual 3 - How it should look:

1	A	B	C	D	E
2	MRI Of Spine	,	John Smith, M.D.	,	12-16-2014
3	CT Of Brain W/O Con	,	Jill Hill PA-C	,	12-20-2014
4	X-Ray and EKG	,	Clinic City View Of NY	,	11-14-2015
5
6

<tbody>
</tbody>

 

[hiker95]

can we try making the worksheet page named "words 2" column A to be where the excluded words would be listed?

skyport,

And, what are the words, in worksheet words 2, in column A?


See reply #2 at the next link, if you want to show small screenshots.

http://www.mrexcel.com/forum/about-board/508133-attachments.html#post2507729

 

[hiker95]

skyport,

I would prefer not to have to manually enter your raw data in your reply #5.

See reply #2 at the next link, if you want to show small screenshots.

http://www.mrexcel.com/forum/about-board/508133-attachments.html#post2507729

 

[skyport]

The initial words I would add to the words list would be: MRI, X-Rays, CT, EMG, EKG, state abbreviations. However, I was thinking that this is just something that I'll do on my side once the code is set up because I would be adding additional words in there periodically. As a suggestion, if you look at the way the following program does a similar concept for underlining keywords in column K under that program, it gives a suggested idea or mechanism of using the keyword column concept. Simply be aware that that program in general is for a completely different function and I am only using it as an example illustrating why it is not necessary to mention any of the keywords actually in the code. Also please remember that your original code and the new one should be able to work with any columns selected not just one preset or specific column.


Sub UnderlineKeyWords_v2()
Dim AllMatches As Object
Dim itm As Variant, KeyWords As Variant, Keyword As Variant, Data As Variant
Dim tmp(1 To 2000) As Long
Dim DataRng As Range
Dim s As String
Dim i As Long, j As Long, k As Long, StartIndex As Long


Const DataSht As String = "Sheet2" '<- Name of sheet where underlining is done
Const myCol As String = "K" '<- Column of interest on DataSht
Const Delimiter As String = ". " '<-Characters that mark end of heading



Application.ScreenUpdating = False
With Sheets("Words")
KeyWords = .Range("A1", .Cells(Rows.Count, "A").End(xlUp)).Value
End With

For i = 1 To UBound(KeyWords, 1)
KeyWords(i, 1) = "\b" & KeyWords(i, 1) & "(?= |\b|$)"
Next i


With Sheets(DataSht)
.Columns(myCol).Font.Underline = False
Set DataRng = .Range(myCol & 1, .Range(myCol & .Rows.Count).End(xlUp))
End With
Data = DataRng.Value


With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
For i = 1 To UBound(Data, 1)
Erase tmp
s = Data(i, 1)
StartIndex = InStr(s, Delimiter)
If StartIndex > 0 Then
StartIndex = StartIndex + Len(Delimiter)
k = -1
For Each Keyword In KeyWords
.Pattern = Keyword
Set AllMatches = .Execute(s)
For Each itm In AllMatches
k = k + 2
tmp(k) = itm.firstIndex + 1
tmp(k + 1) = itm.Length
Next itm
Next Keyword
With DataRng.Cells(i)
For j = 1 To k Step 2
If (tmp(j) >= StartIndex) Then
.Characters(tmp(j), tmp(j + 1)).Font.Underline = True
End If
Next j
End With
End If
Next i
End With

Application.ScreenUpdating = True
End Sub



Regarding the screenshot, I am so very appreciative of what you do here on the site to help that I certainly want to follow what ever makes it easiest on your side however, I am confused on that one because to me a screenshot is when I do a screen capture with the print screen key, which cannot be altered on your end whereas the example I gave above can be quickly copied and pasted into Excel to test. Sorry for the ignorance on my end on that one however, if you want to try to explain it to me again I will do whatever is necessary for your kind help. Final note: Please understand I move a little slowly with a handicap. Sorry about that.

 

[hiker95]

skyport,

If you are not able to provide actual screenshots, then, how about:

You can post your workbook/worksheets to the following free site (sensitive data changed), and provide us with a link to your workbook:

https://dropbox.com

 

[Caleeco]

Can you not have your data in column A1. Then in Cell B1 have this forumla:

=PROPER(A1)

Then Copy cells in B2 down.