How to extract the multiplied numbers from the given string?

I need to extract the multiplied numbers from the given strings.
The multiplication parameter (as a string) is either "x" or "*" (asterisk sign).
The numbers itself may contain (or not) the inch sign (double quotes ").
There is a white space may be found (or not) between multiplication parameter and numbers itself.
I have tried the below function, But it extracts all numbers from string and combine them.
also case sensitivity is not important as I am always using Option Compare Text on all my macros.

Function GetNumeric(CellRef As String)
    Dim StringLength As Long, i As Long, Result As Variant
    StringLength = Len(CellRef)
    For i = 1 To StringLength
      If IsNumeric(Mid(CellRef, i, 1)) Then
         Result = Result & Mid(CellRef, i, 1)
      End If
    Next i
    GetNumeric = Result
End Function

This answer is based on your previous questions and the answers given to those. It assumes that you would also have different looking sample data like 3 inch * 5 in for example. You could again create your own UDF based on a regular expression. For this case I created an 'RegexExtract' and 'RegexReplace' function:

Public Function RegexExtract(str As String, pat As String, Optional gFlag As Boolean = False, Optional pos As Integer = 0, Optional cse As Boolean = True) As String

Static RE As Object: If RE Is Nothing Then Set RE = CreateObject("vbscript.regexp")

RE.Pattern = pat
RE.Global = gFlag
RE.IgnoreCase = cse

If RE.Test(str) Then
    RegexExtract = RE.Execute(str)(pos)
Else
    RegexExtract = vbNullString
End If

End Function

Public Function RegexReplace(str As String, pat As String, rep As String, Optional gFlag As Boolean = True, Optional cse As Boolean = True) As String

Static RE As Object: If RE Is Nothing Then Set RE = CreateObject("vbscript.regexp")

RE.Pattern = pat
RE.Global = gFlag
RE.IgnoreCase = cse
RegexReplace = RE.Replace(str, rep)

End Function

I called the functions using:

=RegexReplace(RegexExtract(A2,"\d+(?:\.\d+)?(?:''|""|in(?:ch)?\b)?(?:\s*[*x]\s*\d+(?:\.\d+)?(?:''|""|in(?:ch)?\b)?)*\s*[*x]\s*\d+(?:\.\d+)?"),"(\d+(?:\.\d+)?)[^\d.]+","$1x")

This results in:

RegexExtract:

This part would look at your input and extract a substring based on this pattern:

\d+(?:\.\d+)?(?:''|"|in(?:ch)?\b)?(?:\s*[*x]\s*\d+(?:\.\d+)?(?:''|"|in(?:ch)?\b)?)*\s*[*x]\s*\d+(?:\.\d+)?

See an online demo

• \d+(?:\.\d+)?(?:''|"|in(?:ch)?\b)? - Match digits with optional decimals and optional trailing inch demarcation;
• (?: - Open a non-capture group;
  • \s*[*x]\s* - Match an asterisk or literal 'x' between 0+ whitespace chars;
  • \d+(?:\.\d+)?(?:''|"|in(?:ch)?\b)? - Match the same pattern as in the 1st bullit;
  • )* - Close the non-capture group and match it 0+ times.

RegexReplace:

This part would look at your input and replace a substring based on this pattern:

(\d+(?:\.\d+)?)[^\d.]+

See an online demo

• (\d+(?:\.\d+)?) - A 1st capture group to match digits with optional decimals;
• [^\d.]+ - 1+ (Greedy) characters other than digit or dot.

Replace with a backreference to this 1st group:

$1x

Note: The link will show a different pattern to exclude newline chars from the samples.

Use simple replace:

Function GetNumeric(CellRef As String) As String
    GetNumeric = Replace(CellRef, " ", "")
    GetNumeric = Replace(GetNumeric, """", "")
    GetNumeric = Replace(GetNumeric, "'", "")
    GetNumeric = Replace(GetNumeric, "*", "x")
End Function

This would work, however, Option Compare Text is going to cause problems if you have uppercase Xs in your sample data..

Function GetNumeric(CellRef As String)
    Dim include As String, i As Long
    include = "0123456789.x*"
    For i = 1 To Len(CellRef)
        If InStr(1, include, Mid(CellRef, i, 1)) <> 0 Then GetNumeric = GetNumeric & Mid(CellRef, i, 1)
    Next
    GetNumeric = Replace(GetNumeric, "*", "x")
End Function

If you need a function that works with Option Compare Text, you can use:

Function GetNumeric2(CellRef As String)
    Dim include As String, i As Long, j As Long
    include = "0123456789.x*"
    For i = 1 To Len(CellRef)
        For j = 1 To Len(include)
            If Asc(Mid(CellRef, i, 1)) = Asc(Mid(include, j, 1)) Then GetNumeric2 = GetNumeric2 & Mid(CellRef, i, 1)
        Next
    Next
    GetNumeric2 = Replace(GetNumeric2, "*", "x")
End Function

Finally, a version that should allow for 2X2:

Function GetNumeric3(CellRef As String)
    Dim include As String, i As Long
    include = "0123456789.x*"
    For i = 1 To Len(CellRef)
        If InStr(1, include, Mid(CellRef, i, 1)) <> 0 Then GetNumeric3 = GetNumeric3 & Mid(CellRef, i, 1)
    Next
    GetNumeric3 = Replace(GetNumeric3, "*", "x")
    For i = 1 To Len(GetNumeric3)
        If Left(GetNumeric3, 1) = "x" Then GetNumeric3 = Mid(GetNumeric3, 2)
        If Right(GetNumeric3, 1) = "x" Then GetNumeric3 = Left(GetNumeric3, Len(GetNumeric3) - 1)
    Next
    GetNumeric3 = LCase(GetNumeric3)
End Function

Thanks to FunThomas for the assist.

Result:

You can use this function together with a lookup table:

=LET(colLookup,VSTACK(tblLookup,CHAR(SEQUENCE(26,,65))),
step1, REDUCE([@[Current String]],colLookup,
     LAMBDA(a,b,SUBSTITUTE(a,b,""))),
SUBSTITUTE(step1,"x","*"))

CHAR(SEQUENCE(26,,65) creates a list from A to Z

--- Update: VBA solution

Public Function replaceExt(t As String) As String

Dim charToReplace As Variant
charToReplace = Array("""", "'", " ")

Dim i As Long
'replace defined characters
For i = 0 To UBound(charToReplace)
    t = Replace(t, charToReplace(i), "")
Next

'now replace all upper charachters ASCII 65 to 90
For i = 65 To 90
    t = Replace(t, Chr(i), "")
Next

'Finally replace lower case x by *
t = Replace(t, "x", "*")
replaceExt = t
End Function