Sub My_Date()

   Dim endRow As Long
     
     endRow = Cells(rows.Count, "B").End(xlUp).row

    ActiveCell.FormulaR1C1 = _
        "=DATEVALUE(IF(LEFT(RIGHT(LEFT(RC[1],FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),5))-1),FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),5))-FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),4))-1),3)=TEXT(TODAY()-1,""Mmm""),RIGHT(LEFT(RC[1],FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),5))-1),FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),5))-FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHA" & _
        "-1),IF(LEFT(RIGHT(LEFT(RC[1],FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),6))-1),FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),6))-FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),5))-1),3)=TEXT(TODAY()-1,""Mmm""),RIGHT(LEFT(RC[1],FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),6))-1),FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),6))-FIND(CHAR(1),SUBSTITUTE(RC[1],""_"",CHAR(1),5)" & _
        """)))"
    
    range("B2").Autofill Destination:=range("B2:B" & endRow)
    
   End Sub

CodePudding user response：

You could write your own function.

This will split your text by the _ delimiter and return the bit that can be turned into a date.

Sub Test()

    Dim endRow As Long
    With ThisWorkbook.Worksheets("Sheet1")
        endRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Range(.Cells(2, 1), .Cells(endRow, 1)).FormulaR1C1 = "=ExtractDate(RC2)"
    End With
    

End Sub

Public Function ExtractDate(Target As Range, Optional Delim As String = "_") As Variant

    Dim SplitText As Variant
    SplitText = Split(Target, Delim)
    
    Dim Itm As Variant
    For Each Itm In SplitText
        If IsDate(Itm) Then
            ExtractDate = CDate(Itm)
            Exit For
        End If
    Next Itm
    
    'If no date found return an #N/A error.
    If ExtractDate = 0 Then ExtractDate = CVErr(xlErrNA)

End Function

The cell reference in the Test procedure "=ExtractDate(RC2)" is in the R1C1 format - it means this row (where the formula appears), column 2.

CodePudding user response：

The solution proposed by Darren Bartrup-Cook has a serious pitfall: IsDate and CDate functions work with the month names in a current locale. Which means that in general case they do not recognize May 03 and alike as a date

Let's make it work. Here are the assumptions about our data:

1. There's a pattern in Product Names with _ as a delimiter: the date always comes sixth in a row.
2. The year is always meant to be the current one.
3. The name of the month is always indicated in full.

Function ExtractDate(Text As String)
Const Delimiter = "_"
Const Position = 5   ' starting from zero
    ExtractDate = Split(Text, Delimiter)(Position)
End Function
 
Sub Main_Macro()
Dim Source As Range
Dim DateArea As Range
    Set Source = Range(Range("B2"), Range("B2").End(xlDown))
    Set DateArea = Source.Offset(0, -1)
    With DateArea
        .NumberFormat = "[$-409]mmmm d"
        .Formula2R1C1 = "=ExtractDate(RC[1])"
        .Value2 = .Value2
        .NumberFormat = "dd-mm-yyyy"
    End With
End Sub

Here:

• "[$-409]mmmm d" force to recognize months in English
• .Value2 = .Value2 replace the formula with real data
• .NumberFormat = "mm-dd-yyyy" set the date format in a current locale