VBA - uppercase of the first letter in each word, while the rest remains intact

[Kita]

Hi,

Pleased to ask a question and hoping for some help.

I am a very noob user, who has been trying to crack this issue for a while with no success.

I am trying to write a code in VBA in Excel and I have two goals in the following order (oh, well - it's one goal, but my nooby mind suggests two steps):
1. To change/keep the first letter of each word in the string as uppercase, while all the rest is left intact.
2. Once the first item is done, then to change the first letter of specific words into lowercase and to completely delete specific, unwanted words.

I have been dealing with the first time for long. Myself:

a. I have managed to change all the first letter to capitals, but, at the same time, all the rest was changed to small letters (which does not help me at all).
b. I have managed to change the case of all the first letters to the opposite. If it was lowercase, then it changed to uppercase (success!). However, if it was already in uppercase, then it changed to lowercase (duh, failure!).

As such, would anyone be able to suggest a code, which changes/keeps the first letter as uppercase and keeps all other letters intact?

For the second item, I already have a solution, which has been running smoothly for me. I created a simple code where:
a. I made a list with all my source words (with the first letter as uppercase) that I want to substitute,
b. I made a list with all my target words (with the first letter as lowercase).

This is what I have been using for the item two:

Sub Prepositions()
from = Array("In", "En", "Pour", "Para", "A", "Per", "Di", "De", "Avec", "Contre", "Dans", "Entre", "Par", "Sans", "Sur", "Bis", "Für", "Aus", "Mit", "Nach", "Von", "Auf", "Sopra", "Tra", "Da", "Con", "Contra", "Por", "Sin", "Dot", "Dot ", "dot", "dot ")
too = Array("in", "en", "pour", "para", "a", "per", "di", "de", "avec", "contre", "dans", "entre", "par", "sans", "sur", "bis", "für", "aus", "mit", "nach", "von", "auf", "sopra", "tra", "da", "con", "contra", "por", "sin", "", "", "", "")

For i = LBound(from) To UBound(from)
Cells.Replace What:=from(i), Replacement:=too(i)
Next i
End Sub

Lastly, I am happy to illustrate you my issue.


Here is the sample source string in Excel and the target string that I want to achieve after running my sub in Excel:

22286


I hope I have described my issue clearly and I am keenly looking forward to some pieces of advice on my issue #1, which has been blocking me for a while.

Thank you!

[p45cal]

This should do step 1 successfully; it acts on the currently selected cells:
Sub blah()
For Each cll In Selection.Cells
xx = Split(cll.Value)
For i = LBound(xx) To UBound(xx)
xx(i) = UCase(Left(xx(i), 1)) & Mid(xx(i), 2)
Next i
cll.Value = Join(xx)
Next cll
End Sub

[p45cal]

I notice that if a word such as En or A is at the beginning of the sentence, that it will still be converted to en or a. The following may be of some use because it leaves all the words in the too array as they were originally.
Sub blah()
too = Array("in", "en", "pour", "para", "a", "per", "di", "de", "avec", "contre", "dans", "entre", "par", "sans", "sur", "bis", "für", "aus", "mit", "nach", "von", "auf", "sopra", "tra", "da", "con", "contra", "por", "sin")
For Each cll In Selection.Cells
xx = Split(cll.Value)
For i = LBound(xx) To UBound(xx)
If IsError(Application.Match(xx(i), too, 0)) Then xx(i) = UCase(Left(xx(i), 1)) & Mid(xx(i), 2)
Next i
cll.Value = Join(xx)
Next cll
End Sub
Now you just need to deal with the dot variants.

Also, be very careful with the .Replace method; Excel remembers the settings used the last time Replace was used (including when it was used manually on the sheet), so you need to ensure that Match case and match entire cell contents tick boxes are correctly set and that you're not looking for a format either, so:
Cells.Replace What:=from(i), Replacement:=too(i)
becomes:
Cells.Replace What:=from(i), Replacement:=too(i), LookAt:=xlPart ,Searchformat:=false

Also be aware that a word such as Pourtant which includes pour, will have its capital letter reduced to lowercase. The same applies to any word beginning with A.

[georgiboy]

Welcome to the forum.

Quite liked this question and may have gone off on a tangent but here's a function that looks up and replaces exclusion words from a range and uses the "Proper" function on all the others.

Hope this helps

[Kita]

That's a stunning help from both of you and thank you for the warm welcome.

Appreciated that you also looked into the step 2 and found what might be fixed.

I have compiled bits of your codes and knowledge into one sub main with three steps:

1. Make all first letters of each word lowercase.
2. Make all first letters of each word uppercase. At this point, apply the exclusion list (leave the words in the too array as they were originally).
3. Delete the unwanted word.


Sub Main()
For Each cll In Selection.Cells
xx = Split(cll.Value)
For i = LBound(xx) To UBound(xx)
xx(i) = LCase(Left(xx(i), 1)) & Mid(xx(i), 2)
Next i
cll.Value = Join(xx)
Next cll


too = Array("in", "with", "en", "pour", "para", "a", "per", "di", "de", "avec", "contre", "dans", "entre", "par", "sans", "sur", "bis", "für", "aus", "mit", "nach", "von", "auf", "sopra", "tra", "da", "con", "contra", "por", "sin")
For Each cll In Selection.Cells
xx = Split(cll.Value)
For i = LBound(xx) To UBound(xx)
If IsError(Application.Match(xx(i), too, 0)) Then xx(i) = UCase(Left(xx(i), 1)) & Mid(xx(i), 2)
Next i
cll.Value = Join(xx)
Next cll


For Each cll In Selection.Cells
Selection.Replace What:="dot ", Replacement:=""
Next cll
End Sub

Some background - I deal with multiple stakeholders and they deliver me these Excel files with all of those strings. Dealing with multiple stakeholders means that each of them will always deliver me a bit different string with different capitalization pattern and so on, so I want to standardize the look of the text across all the cells. Therefore, I opened this thread.

Short additional explanation - I did it in this order because sometimes the words from the too array come to me, starting with a lowercase and sometimes with an uppercase (and I need to change/keep them all to the lowercase). If I completely followed your code, then I would have a problem with substituting, let's say, "With" into "with" because "With" would be kept on the exclusion list (too array), hence it would not be changed into lowercase.

The created function works smoothly on my end and I'm gonna keep it as a backup option. Easy to use and effective and... easy to explain to other people.

To sum up - I have run the above code for a couple of times and it seems to work like a charm, but could I just please ask you to have a look to check if there are any potential errors/problems that I might encounter in the future (and that I haven't been able to notice myself)? I am compiling these codes based on your suggestions, some online tutorials, and Google, so I'm no expert at all.

[p45cal]

You can combine the first two blocks of code into one.
I've deleted the unnecessary For each cll loop.
Added a few more arguments to the .Replace line. On that line you should experiment with MatchCase:=True/MatchCase:=False to be sure it gives you what you want.

Be aware that this will initially and unconditionally make the first letter of every word lower case, including the very first word in the string.

Why don't you run this on a whole bunch of cells, then come back here with examples of just those results which aren't quite right, including how they were originally, and how you'd likethem to be.

Sub Main()
too = Array("in", "with", "en", "pour", "para", "a", "per", "di", "de", "avec", "contre", "dans", "entre", "par", "sans", "sur", "bis", "für", "aus", "mit", "nach", "von", "auf", "sopra", "tra", "da", "con", "contra", "por", "sin")
For Each cll In Selection.Cells
xx = Split(cll.Value)
For i = LBound(xx) To UBound(xx)
xx(i) = LCase(Left(xx(i), 1)) & Mid(xx(i), 2)
If IsError(Application.Match(xx(i), too, 0)) Then xx(i) = UCase(Left(xx(i), 1)) & Mid(xx(i), 2)
Next i
cll.Value = Join(xx)
Next cll
Selection.Replace What:="dot ", Replacement:="", LookAt:=xlPart, Searchformat:=False, MatchCase:=False
End Sub

[georgiboy]

Here is a revised function, you could convert it to a sub if you needed to:


Function FixString(rCell As Range)
Dim var As Variant, too As Variant, Exclusion As Boolean

Application.Volatile
too = Split("with,a,of", ",")
var = Split(rCell, " ")

For x = LBound(var) To UBound(var)
Exclusion = False

For y = LBound(too) To UBound(too)
If LCase(too(y)) = Application.Trim(LCase(var(x))) Then
var(x) = too(y)
Exclusion = True
Exit For
End If
Next y

If Exclusion = False Then
var(x) = UCase(Left(var(x), 1)) & Right(var(x), Len(var(x)) - 1)
End If

If Application.Trim(LCase(var(x))) = "dot" Then var(x) = " "
Next x

FixString = Application.Trim(Join(var))

End Function

Hope this helps

[Kita]

I'd like to say "thank you" to both of you once more.

I have been running the revised code and it has been working smoothly since then; however, I am still to analyze some larger set of data in the next dates to catch some edge cases (for now, it looks brilliant but I have been able to run it only on a couple of dozens of real-life examples). I will gladly update this thread in case of further inquiries.

P.S. I'll mark this thread as resolved in the next week (wanna give some time to myself to find edge cases, if any).

[SamT]

Kita,

I like your style. Hope you stick around,
Sam

[SamT]

After a bit of consideration, to handle "edge" conditions, and future changes...

On a hidden sheet, start a list of all "special" words in column A, make all them UPPERCASE.
In column B pace some "action" notes. I only see the need for three + 1 notes: Upper, Lower, Delete, and a replacement Word for special cases like CamelCase.



Special Words

Action To Take

function results


TODAY
Upper

Today


TOMORROW
Lower

tomorrow


NEXTWEEK
NextWeek

NextWeek


NEVER
Delete

















Now, to borrow a bit of p45cal's code


Set Specials = Sheets("Hidden"???).Range("A1").CurrentRegion.Value

For Each cll In Selection.Cells
xx = Split(cll.Value)
For i = LBound(xx) To UBound(xx)
For j = LBound(Specials) + 1 to Ubound(specials) '+1 = Skip The headers in Specials
If UCase(xx(i)) = Specials(j, 1) Then
Select Case Specials(j, 2)
Case "Upper"
'Your code here to Make xx(i) ProperCase
Case "Lower"
'your code here to Make xx(i) Lower Case
Case "Delete"
'your code here to delete that word (plus one space)
Case Else
'Your code to Make xx(i) = Specials(j, 2)
End Select
Exit For ' There can be only one for each xx(i)
End If
Next j
Next i
Next cll