How to separate string and date value from a string.

[ThrottleWorks]

Hi,

Please see attached file for details.
I have various strings, I need to separate string and date value from this string.
For example, input value = ABC 2012-AB4 A2 1.801% 10OCT2017

Output value will be date = 10, month = 10, year = 2017, final string will be ABC 2012-AB4 A2 1.801%
Or input value = AAAAA 2B2480 2.915% 04/01/2044

Output value will be date = 1, month = 4, year = 2044, final string will be AAAAA 2B2480 2.915%
Can anyone please help me in this.

 

[Marc L]

Hi !

As it depends on regional computer setting,
first try this codeline : MsgBox IsDate("15JUL2049") …

If it's true, you can use Split function to check each text part
between space, CDate to convert text to a Date variable then
Year, Month and Day functions to extract date parts
as you can see in VBA inner help …
​

 

[Chihiro]

Not fully tested.

Sub Test()
Dim resArr, x
Dim lRow As Long
Dim RegEx As Object, matchList As Object

lRow = Cells(Rows.Count, "A").End(xlUp).Row
myArray = Range("A3:A" & lRow).Value
ReDim resArr(1 To lRow - 2, 1 To 4)
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
    .Global = True
    .IgnoreCase = True
End With

For i = 1 To lRow - 2
    RegEx.Pattern = "[0-9]{2}[a-z]{3}[0-9]{4}"
    Set matchList = RegEx.Execute(myArray(i, 1))
    If matchList.Count <> 0 Then
        resArr(i, 1) = Left(matchList.Item(0), 2)
        resArr(i, 2) = Month(DateValue("01 " & Mid(matchList.Item(0), 3, 3) & " 2017"))
        resArr(i, 3) = Right(matchList.Item(0), 4)
        resArr(i, 4) = Trim(Replace(Replace(myArray(i, 1), matchList.Item(0), ""), "REGS", ""))
    Else
        RegEx.Pattern = "\d\d\/\d\d\/\d\d\d\d"
        Set matchList = RegEx.Execute(myArray(i, 1))
        If matchList.Count <> 0 Then
            x = Split(matchList.Item(0), "/")
            resArr(i, 1) = x(1)
            resArr(i, 2) = x(0)
            resArr(i, 3) = x(2)
            resArr(i, 4) = Trim(Replace(Replace(myArray(i, 1), matchList.Item(0), ""), "REGS", ""))
        Else
            resArr(i, 4) = myArray(i, 1)
        End If
    End If
Next
Range("B3").Resize(lRow - 2, 4) = resArr

Set RegEx = Nothing
Set matchList = Nothing
End Sub

 

[ThrottleWorks]

Hi @Chihiro sir,

Thanks a lot for the help. It is working great.

However, for your information, for few strings, macro is not able to derive string part as expected.

For example, input = AAAAA 5.75 15MAR2022 144A, macro output = AAAAA 5.75 144A.

Ideally it should have been AAAAA 5.75, I guess since 144A is starting with number it is causing issues.

Cause, for input =AAAAAA FRN 07MAR2067 REGS macro output = AAAAAA FRN is perfect.

Once again, thanks a lot. Have a nice day ahead.

Also sir, REGS won't be always there, there might be another values instead of REGS.

 

[ThrottleWorks]

Hi @Marc L sir, thanks a lot for the help, have a nice day ahead.

 

[Chihiro]

Then instead of Replace function, use Split using matchList.Item(0) as delimiter.

 

[jindon]

Sub test()
    Dim a, i As Long, myMonth As String, m As Object
    With Cells(1).CurrentRegion.Resize(, 5)
        .Offset(2, 1).ClearContents
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Pattern = "(.+) ((\d{2})/(\d{2})/(\d{4})|(\d{2})([A-Z]{3})(\d{4})).*"
            For i = 3 To UBound(a, 1)
                If .test(a(i, 1)) Then
                    Set m = .Execute(a(i, 1))(0).submatches
                    a(i, 5) = m(0)
                    a(i, 2) = m(2) & m(5)
                    If m(6) <> "" Then
                        myMonth = Switch(m(6) = "JAN", 1, m(6) = "FEB", 2, m(6) = "MAR", 3, _
                        m(6) = "APR", 4, m(6) = "MAY", 5, m(6) = "JUN", 6, m(6) = "JUL", 7, _
                        m(6) = "AUG", 8, m(6) = "SEP", 9, m(6) = "OCT", 10, m(6) = "NOV", 11, _
                        m(6) = "DEC", 12)
                    End If
                    a(i, 3) = m(3) & myMonth: myMonth = ""
                    a(i, 4) = m(4) & m(7)
                Else
                    a(i, 5) = a(i, 1)
                End If
            Next
        End With
        .Value = a
    End With
End Sub

 

[ThrottleWorks]

Hi @jindon sir, you are great !

To be honest, I am still going through your code, will take time to understand what is exactly happening.

Have nice day ahead.

 

[ThrottleWorks]

Hi @Chihiro sir, thanks a lot for your time and help.

Have a nice day ahead.