Change a String to Uppercase if it Exists - VBA - excel

Question

How do I change a particular string to Uppercase only if it exists.
If (Cells(i, "A") Like "*roada*") Or (Cells(i, "A") Like "*roadb*") _
Or (Cells(i, "A") Like "*roadc*") etc... Then 'Change only the found string to Uppercase.
Each cell contains two or more words. Example: Cell A1 consists of "roadhouse blues". I want only 'roadh' to change to Uppercase if it exists in that cell. Is this possible in VBA?

Answer 1

This will do the trick:
Const road As String = "road"
Dim s As String
Dim letterAfterRoad As String
s = "play that roadhouse blues" ' or get contents of some cell
letterAfterRoad = Mid(s, InStr(s, road) + Len(road), 1)
Mid(s, InStr(s, road)) = UCase(road & letterAfterRoad)
Debug.Print s ' returns "play that ROADHouse blues". Write to cell.
If I were you, I would heed #minitech's sarcastic remark. If what you're looking for is road? where ? is a letter a-z then let Like look for a-z rather than manually typing the entire alphabet...
Here is how I would do it:
Const road As String = "road"
Dim s As String
Dim charAfterRoad As String
Dim roadPos As Long
s = "play that roadhouse blues"
roadPos = InStr(s, road)
If roadPos > 0 And Len(s) >= roadPos + Len(road) Then
'Found "road" and there is at least one char after it.
charAfterRoad = Mid(s, roadPos + Len(road), 1)
If charAfterRoad Like "[a-z]" Then
Mid(s, InStr(s, road)) = UCase(road & charAfterRoad)
End If
End If
Debug.Print s ' returns "play that ROADHouse blues"

Answer 2

Here is another way. Let Excel do the dirty work ;)
Sub Sample()
Dim SearchString As String
Dim ReplaceString As String
Dim aCell As Range
'~~> Search String
SearchString = "roadh"
'~~> Replace string
ReplaceString = UCase(SearchString)
'~~> Change A1 to to the respective cell
Set aCell = Range("A1").Find(What:=SearchString, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
'~~> If Found
If Not aCell Is Nothing Then
Range("A1").Replace What:=SearchString, Replacement:=ReplaceString, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
End Sub
Also instead of looping you might want to use .FIND/.FINDNEXT ?
More on 'Find/FindNext': http://www.siddharthrout.com/index.php/2018/01/05/find-and-findnext-in-excel-vba/
FIND/FINDNEXT is far much more faster then looping and searching for values in Excel Cells ;)
AND the below is even faster (in fact the fastest). You don't need to find the word if your final intention is to replace the word. Simply issue the replace command. If the code finds any word then it will automatically replace.
Sub Sample()
Dim SearchString As String
Dim ReplaceString As String
'~~> Search String
SearchString = "roadh"
'~~> Replace string
ReplaceString = UCase(SearchString)
'~~> Replace the range below with the respective range
Range("A1:A1000").Replace What:=SearchString, Replacement:=ReplaceString, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
You don't need to use the wildcard character to check for the presence of a string inside a string. xlPart in "LookAt:=xlPart" takes care of that :)
FOLLOWUP (In Case the user meant this)
You may be missing the point here... OP is not only looking for roadh but for any road? where ? is a letter a-z. You have to figure out what ? is and make it uppercase. That's the (mildly) interesting twist of this problem. – Jean-François Corbett 1 hour ago
Also checking for the scenario where the cell can contain multiple "road" values (as shown in snapshot below which has a 'before' and 'after' snapshot.
Sub Sample()
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim ExitLoop As Boolean
Dim SearchString As String, FoundAt As String
On Error GoTo Whoa
Set ws = Worksheets("Sheet1")
Set oRange = ws.Columns(1)
SearchString = "road"
Set aCell = oRange.Find(What:=SearchString & "?", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
FoundAt = aCell.Address
aCell.Value = repl(aCell.Value, SearchString)
Do While ExitLoop = False
Set aCell = oRange.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
FoundAt = FoundAt & ", " & aCell.Address
aCell.Value = repl(aCell.Value, SearchString)
Else
ExitLoop = True
End If
Loop
MsgBox "The Search String has been found these locations: " & FoundAt & " and replaced by UPPERCASE"
Else
MsgBox SearchString & " not Found"
End If
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Function repl(cellValue As String, srchString As String) As String
Dim pos As Integer
pos = InStr(1, cellValue, srchString, vbTextCompare)
repl = cellValue
Do While pos <> 0
If pos = 1 Then
repl = UCase(Left(repl, Len(srchString) + 1)) & Mid(repl, Len(srchString) + 2)
Else
repl = Mid(repl, 1, pos - 1) & UCase(Mid(repl, pos, Len(srchString) + 1)) & _
Mid(repl, pos + Len(srchString) + 1)
End If
Debug.Print repl
pos = InStr(pos + 1, repl, srchString, vbTextCompare)
Loop
End Function
Snapshot:
HTH
Sid

Answer 3

A way with a regexp, replaces all Road* in the input.
Sub repl(value As String)
Dim re As Object: Set re = CreateObject("vbscript.regexp")
Dim matches As Object, i As Long
re.IgnoreCase = True
re.Global = True
re.Pattern = "(road[A-Z])"
Set matches = re.Execute(value)
For i = 0 To matches.Count - 1
value = Replace$(value, matches(i), UCase$(matches(i)))
Next
Debug.Print value
End Sub