Change a String to Uppercase if it Exists - VBA

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