How to format strings with numbers and special characters in Excel or Access using VBA?

Question

I have a mathematical problem: these five strings are IDs for the same object. Due to these differences, objects appear multiple times in my Access table/query. Although there are a lot of these mutations, but I take this as an example.

76 K 6-18
76 K 6-18(2)
0076 K 0006/ 2018
0076 K 0006/2018
76 K 6/18

How would the VBA-code have to look like to recognize that these numbers stand for the same thing , so a general formatting with "RegEx()" or "format()" or "replace()"...but they must not only refer to this example but to the kind.

The common factor of these and all other mutations is always the following:

1) includes "-", no zeros left of "-", just 18 an not 2018 (year) at the end. 2) is like the first but with (2) (which can be dropped). 3) includes "/", zeros left of "/", and 2018 as year at the end. 4) is like third, but without space after "/". 5) is like the first one, but with a "/" instead of "-".

Character is always one single "K"! I suppose the best way would be to convert all 5 strings to 76 K 6 18 or in ohter cases for example to 1 K 21 20 or 123 K 117 20 . Is this possible with one elegant code or formula? Thanks

Answer 1

Here is a fun alternative using a rather complex but intuitive regular expression:

^0*(\d+) (K) 0*(\d+)[-\/] ?\d{0,2}(\d\d)(?:\(\d+\))?$

See an online demo

• ^ - Start line anchor.
• 0* - 0+ zeros to catch any possible leading zeros.
• (\d+) - A 1st capture group of 1+ digits ranging 0-9.
• - A space character.
• (K) - 2nd Capture group capturing the literal "K".
• - A space character.
• (\d+) - A 3rd capture group of 1+ digits ranging 0-9.
• [-\/] - Character class of either a hyphen or forward slash.
• ? - An optional space character.
• \d{0,2} - 0-2 digits ranging from 0-9.
• (\d\d) - A 4th capture group holding exactly two digits.
• (?:\(\d+\))? - An optional non-capture group holding 1+ digits inside literal paranthesis.
• $ - End line anchor.

Now just replace the whole string by the 4 capture groups with spaces in between.

---

Let's test this in VBA:

'A code-block to call the function.
Sub Test()

    Dim arr As Variant: arr = Array("76 K 6-18", "76 K 6-18(2)", "0076 K 0006/ 2018", "0076 K 0006/2018", "76 K 6/18")

    For x = LBound(arr) To UBound(arr)
        Debug.Print Transform(CStr(arr(x)))
    Next

End Sub

'The function that transform the input.
Function Transform(StrIn As String) As String

    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "^0*(\d+) (K) 0*(\d+)[-\/] ?\d{0,2}(\d\d)(?:\(\d+\))?$"
        Transform = .Replace(StrIn, "$1 $2 $3 $4")
    End With

End Function

All the elements from the initial array will Debug.Print "76 K 6 18".

Hope it helps, happy coding!

---

EDIT: If your goal is just to check if your string compiles against the pattern, the pattern itself can be shortened a little and you can return a boolean instead:

'A code-block to call the function.
Sub Test()

    Dim arr As Variant: arr = Array("76 K 6-18", "76 K 6-18(2)", "0076 K 0006/ 2018", "0076 K 0006/2018", "76 K 6/18")

    For x = LBound(arr) To UBound(arr)
        Debug.Print Transform(CStr(arr(x)))
    Next

End Sub

'The function that checks the input.
Function Transform(StrIn As String) As Boolean

    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "^0*\d+ K 0*\d+[-\/] ?\d{2,4}(?:\(\d+\))?$"
        Transform = .Test(StrIn)
    End With

End Function

Answer 2

As @Vincent has suggested, look at using a custom function to convert all of the different data to be consistent. Based on what you have described, the following seems to work:

Function fConvertFormula(strData As String) As String
    On Error GoTo E_Handle
    Dim astrData() As String
    strData = Replace(strData, "/", " ")
    strData = Replace(strData, "-", " ")
    strData = Replace(strData, "  ", " ")
    astrData = Split(strData, " ")
    If UBound(astrData) = 3 Then
        astrData(0) = CLng(astrData(0))
        astrData(2) = CLng(astrData(2))
        If InStr(astrData(3), "(") > 0 Then
            astrData(3) = Left(astrData(3), InStr(astrData(3), "(") - 1)
        End If
        If Len(astrData(3)) = 4 Then
            astrData(3) = Right(astrData(3), 2)
        End If
        fConvertFormula = Join(astrData, " ")
    End If
fExit:
    On Error Resume Next
    Exit Function
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "fConvertFormula", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume fExit
End Function

It starts by replacing "field" delimiters with spaces, and then does a replace of double spaces. It then removes any leading zeroes from the first and third elements, if there is a bracket in the last element then delete that part, and finally converts to a 2 digit value before joining it all back up.

You may have other cases that you need to deal with, so I would suggest creating a query with the original data and the data converted by this function, and seeing what it throws out.

Answer 3

This function unifies the given string by the rules you defined in your question:

Public Function UnifyValue(ByVal inputValue As String) As String
        '// Remove all from "(" on.
        inputValue = Split(inputValue, "(")(0)
        '// Replace / by blank
        inputValue = Replace(inputValue, "/", " ")
        '// Replace - by blank
        inputValue = Replace(inputValue, "-", " ")
        '// Replace double blanks by one blank
        inputValue = Replace(inputValue, "  ", " ")
        '// Split by blank
        Dim splittedInputValue() As String
        splittedInputValue = Split(inputValue, " ")
        '// Create the resulting string
        UnifyValue = CLng(splittedInputValue(0)) & _
                     " " & splittedInputValue(1) & _
                     " " & CLng(splittedInputValue(2)) & _
                     " " & Right(CLng(splittedInputValue(3)), 2)
End Function

It always returns 76 K 6 18 regarding to your sample values.