VBA function Regex

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

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.

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).