Edit String dependent on first word

[DenialDan]

I'm trying cut all the words of a string except the first one and paste the resulting "new" string in the cell where the old one was. This is the code I came up with so far:

Sub CECorrect()


Dim i As Integer
Dim s As String
Dim indexOfString As Integer
Dim finalString As String


For i = 4 To 10000


    s = Sheets("Sheet Name").Cells(i, 31).Value ' the first string is at AE4
    indexOfString = InStr(1, s, "Strong") ' the word to be extracted here is "Strong"
    finalString = Left(s, Len(s) - indexOfString + 1)
    
    Sheets("Sheet Name").Cells(i, 31) = finalString
    
Next i


End Sub

Just some sidenotes:

• cells (i.e. AE4) can be empty, the data changes weekly, tell me if that's a problem
• "Strong" isn't the only word I need extracted, the others are "Moderate" and "Weak" but they are all in the same column

 

[mole999]

if you choose to detect the left 4 characters as uppercase, WEAK, STRO, MODE then you could use something to replace the Cell contents

=UPPER(LEFT(Cell contents,4) = onwards