VBA function Regex - regex

Question

Do you have an idea of what is wrong in this code please? It should extract all caps and the pattern "1WO" if available.
For example in "User:399595:Account:ETH:balance", i should have "UAETH" and in "User:197755:Account:1WO:balance" i should have "UA1WO"
Thank you
Option Explicit
Function ExtractCap(Txt As String) As String
Application.Volatile
Dim xRegEx As Object
Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
If xRegEx.Pattern = "[^A-Z]" Then
xRegEx.Global = True
xRegEx.MultiLine = False
ExtractCap = xRegEx.Replace(Txt, "")
Set xRegEx = Nothing
Else: xRegEx.Pattern = "1WO"
ExtractCap = xRegEx.Execute(Txt)
End If
End Function

Answer 1

I'm not a "RegEx" expert, so you may want to try an alternative:
Function ExtractCap(Txt As String) As String
Application.Volatile
Dim i As Long
For i = 1 To Len(Txt)
Select Case Asc(Mid(Txt, i, 1))
Case 65 To 90
ExtractCap = ExtractCap & Mid(Txt, i, 1)
End Select
Next
End Function
while, should the pattern of your data strictly be as you showed, you could also consider:
Function ExtractCap(Txt As String) As String
Application.Volatile
ExtractCap = "UA" & Split(Txt, ":")(3)
End Function

Answer 2

Your RegEx works like this:
Function ExtractCap(Txt As String) As String
Application.Volatile
Dim xRegEx As Object
Set xRegEx = CreateObject("VBScript.RegExp")
With xRegEx
.Pattern = "[^A-Z]"
.Global = True
.MultiLine = False
ExtractCap = .Replace(Txt, vbNullString)
End With
If Txt = ExtractCap Then ExtractCap = "1WO"
End Function
Public Sub TestMe()
Debug.Print ExtractCap("User:399595:Account:ETH:balance")
End Sub
In your code, there were 2 errors, which stopped the execution:
xRegEx was set to Nothing and then it was asked to provide a value;
the check If xRegEx.Pattern = "[^A-Z]" does not actually mean a lot to VBA. E.g., you are setting a Pattern and making a condition out of it. If you want to know whether a pattern exists in a RegEx, you should compare the two strings - before and after the execution of the pattern.

Answer 3

Your problem can be easily solved.
Firstly, I assumed that 1WO can appears at most once in your string.
Based on that assumption, logic is as follows:
Define function, which extracts all capital letters from strings.
Now, in the main function, you split your string first using 1WO as delimeter. Now, pass every string (after splitting) to function, get all the caps from those strings and concatenate them again with 1WO in its place.
Option Explicit
Public Function Extract(str As String) As String
Dim s As Variant
For Each s In Split(str, "1WO")
'append extracted caps with 1WO at the end
Extract = Extract & ExtractCaps(s) & "1WO"
Next
'delete lest 1WO from result
Extract = Left(Extract, Len(Extract) - 3)
End Function
Function ExtractCaps(str As Variant) As String
Dim i As Long, char As String
For i = 1 To Len(str)
char = Mid(str, i, 1)
If Asc(char) > 64 And Asc(char) < 91 And char = UCase(char) Then
ExtractCaps = ExtractCaps & char
End If
Next
End Function
If you put this code in inserted Module, you can use it in a worksheet in formula: =Extract(A1).