Split Uppercase words in Excel and insert delimiters - vba

Question

I have this string:
RugbyFunny RugbyGirls RugbyBoys RugbyWomens Rugby
Basically, I would like to split the words by capital letters and put a delimiter like ;.
I have found a useful VBA function that does part of the job:
Function splitbycaps(inputstr As String) As String
Dim i As Long
Dim temp As String
If inputstr = vbNullString Then
splitbycaps = temp
Exit Function
Else
temp = inputstr
For i = 1 To Len(temp)
If Mid(temp, i, 1) = UCase(Mid(temp, i, 1)) Then
If i <> 1 Then
temp = Left(temp, i - 1) + " " + Right(temp, Len(temp) - i + 1)
i = i + 1
End If
End If
Next i
splitbycaps = temp
End If
End Function
How can I put a delimiter between each word? I would like to produce this outcome:
Rugby;Funny Rugby;Girls Rugby;Boys Rugby;Womens Rugby;
Many thanks in advance for your help!

Answer 1

Change the function to this:
Function SplitByCaps(InputStr As String) As String
Dim i As Long
Dim temp As String
If InputStr = vbNullString Then
SplitByCaps = temp
Exit Function
Else
temp = InputStr
Do While i < Len(temp)
i = i + 1
If Mid(temp, i, 1) <> LCase(Mid(temp, i, 1)) Then
If i <> 1 Then
If Mid(temp, i - 1, 1) <> " " Then
temp = Left(temp, i - 1) & ";" & Right(temp, Len(temp) - i + 1)
i = i + 1
End If
End If
End If
DoEvents
Loop
SplitByCaps = temp
End If
End Function
Edit: Changed it to a Do loop the For counted incorrectly as #Vityata pointed out.
Public Sub Test()
Dim str As String
str = "RugbyFunny RugbyGirls RugbyBoys RugbyWomens Rugby"
Debug.Print SplitByCaps(str)
'Rugby;Funny Rugby;Girls Rugby;Boys Rugby;Womens Rugby
End Sub

Answer 2

Compare based on ASCII values
For i = 1 To Len(TEMP)
If i <> 1 Then
If Asc(Mid(TEMP, i, 1)) >= 65 And Asc(Mid(TEMP, i, 1)) <= 90 Then
TEMP = Left(TEMP, i - 1) + ";" + Right(TEMP, Len(TEMP) - i + 1)
i = i + 1
End If
End If
Next i

Answer 3

First you need to find all the positions of the string, where:
The char is an UpperCase
The char is actually a letter
There is no space before the char
Then, these positions can be saved in a collection. This is a function, finding the next uppercase position, returning -1, if there is not such:
Public Function NextUpperCasePosition(str As String, marker As Long) As Long
Dim i As Long
Dim isUpper As Boolean
Dim isLetter As Boolean
Dim noSpaceBefore As Boolean
If marker = 1 Then
NextUpperCasePosition = 1
Exit Function
End If
For i = marker To Len(str)
noSpaceBefore = CBool(Len(Trim(Mid(str, i - 1, 1))) > 0)
isUpper = CBool(Mid(str, i, 1) = UCase(Mid(str, i, 1)))
isLetter = CBool(LCase(Mid(str, i, 1)) <> UCase(Mid(str, i, 1)))
If isUpper And isLetter And noSpaceBefore Then
NextUpperCasePosition = i
Exit Function
End If
Next i
NextUpperCasePosition = -1
End Function
Once you are able to find the positions and add them to a collection of positions, you can loop through the collection and split the string to an array, based on these numbers. Once the array is ready, the Join(arr, "; ") works quite ok to produce the needed string:
Public Sub SplitByUpperCase()
Dim str As String
str = "KRugbyFunny RugbyGirls RugbyBoys RugbyWomens Rugby K TB"
Dim i As Long
Dim result As New Collection
Dim nextPosition As Long: nextPosition = 1
For i = 1 To Len(str) Step 1
If i = nextPosition Then
nextPosition = NextUpperCasePosition(str, nextPosition)
If nextPosition >= 1 Then result.Add (nextPosition)
nextPosition = nextPosition + 1
End If
Next i
Dim resultArr As Variant
ReDim resultArr(result.Count - 1)
Dim lenOfWord As Long
For i = 1 To result.Count
If i = result.Count Then
lenOfWord = Len(str) - result(i) + 1
Else
lenOfWord = result(i + 1) - result(i)
End If
resultArr(i - 1) = Mid(str, result(i), lenOfWord)
Next i
Debug.Print Join(resultArr, "; ")
End Sub