VBA script to delete Text after dates

[NeoSez]

Would like to delete some useless system text in a column, but not all the text in the cell. Each cell will have date entries. Would like to delete the useless text and the date preceding it. Each date is on a separate line within the cell.
So far, I have the delete text part down, but it doesn't include the date.

Example:
jan 1, 2023 text 1
dec 31, 2022 useless text 123
dec 11, 2022 text 3
dec 3, 2022 useless text 456

 

[mikenelena]

It would helpful to see the full contents of the cell, as a solution will probably be based on a delimiter and positioning of desired text vs. undesired text.

 

[duggie33]

Hi NeoSez,

I agree with mikenelena on seeing the full contents of the cells. If "jan 1, 2023 text 1" is in a single cell, you use a formula: "=DATEVALUE(LEFT(A4,SEARCH(", ????",A4,1)+5))" to convert the date part of the text to a Date formatted value.

I hope this helps,

Doug

 

[NeoSez]

It would helpful to see the full contents of the cell, as a solution will probably be based on a delimiter and positioning of desired text vs. undesired text.

Unfortunately, for confidentiality reasons, I can not show the full contents of the cell. But this is the gist of it. Each cell has a date and then text after it. New line is created within the cell, for each dated entry.
This is what I have so far, but it leaves a bunch of dates behind. I don't know how to get rid of the date with the text that goes with that date. So to remove the whole line and not leave the date behind in the sample below.
eg: Jan 1, 2023 Pigs Can Fly

Sub Remove()
    Dim lastRow As Long
    Dim myRange As Range
    
'   Find lastRow in column E
    lastRow = Cells(Rows.Count, "E").End(xlUp).Row

'   Set range to look at
    Set myRange = Range("E5:I" & lastRow)
    
'   Replace sample1 / Pigs Can Fly/
    myRange.Replace What:="sample1 / Pigs Can Fly/ ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

 

[NeoSez]

Hi NeoSez,

I agree with mikenelena on seeing the full contents of the cells. If "jan 1, 2023 text 1" is in a single cell, you use a formula: "=DATEVALUE(LEFT(A4,SEARCH(", ????",A4,1)+5))" to convert the date part of the text to a Date formatted value.

I hope this helps,

Doug

Thank you for your suggestion. Because of other formulas, it will not be possible, which is why I am look at the VBA as a solution.

 

[duggie33]

This should work to extract the dates from the text. Below is an example of VBA works with Regular Expressions. You must adapt it for the ranges and strings in your workbook.

Sub FindAndCopyDate()

    Dim RegEx As RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strOutput As String
    Dim objMatches As Object
    Dim i As Long
    Dim rng As Range

    Set RegEx = New RegExp
    RegEx.Global = True
    RegEx.IgnoreCase = True

    'Set the RegEx pattern to find the date string within the input string
    RegEx.Pattern = "([a-z]{3} \d{1,2}, \d{4})"

    'Set the range of input string cells
    Set rng = Sheet1.Range("A2:A5")

    For i = 0 To rng.Count - 1
        strInput = Sheet1.Range("A2").Offset(i, 0).Value
    
        ' Find all matches of pattern in input string
        Set objMatches = RegEx.Execute(strInput)

        ' Returning only the first value found in the input string
        strOutput = objMatches(0).Value
        Sheet1.Range("A2").Offset(i, 1).Value = CDate(strOutput)
    Next i

End Sub

 

[Peter_SSs]

jan 1, 2023 text 1
dec 31, 2022 useless text 123
dec 11, 2022 text 3
dec 3, 2022 useless text 456

1. Is that text all in a single cell?
   
   
2. Obviously that is dummy data, which is fine, but what is the logic to determine what is 'useless' text and what is 'useful' text?
   That is, what is the expected outcome from that sample data and what is the logic to determine that?

 

[duggie33]

It is unclear if all text is in one cell or multiple. Also unclear is what to do with the results, delete the "useless text" within the same cell or copy the date to a different cell. Therefore, I provided the example using RegEx to extract the date and write it to an adjacent cell. Suppose the text is all in one cell, a For/Next loop can be implemented to return all of the objMatches. They can be written to individual cells or back into a single cell with line breaks. Pretty much anything can be done with the RegEx objMatches.

To test how the code provided works, put the example data in A2:A5, run the code, and the date formatted dates will be put in column B.

 

[NeoSez]

1. Is that text all in a single cell?
   
   
2. Obviously that is dummy data, which is fine, but what is the logic to determine what is 'useless' text and what is 'useful' text?
   That is, what is the expected outcome from that sample data and what is the logic to determine that?

1. Yes, all that text will be in once cell.
2. Once I find a VBA script that works to remove the date + text, I will be going through the entire spreadsheet to find the useless text, so that I can add that to the script to delete the date preceding that useless text plus the entire phrase after that date.
Examples to delete- If VBA finds the text "Happy New Year, it will delete that phrase plus the date in front of it or "Flowers sent to Ariana": Jan 1, 2023 Happy New Year, February 14, 2020 Flowers sent to Ariana" etc. Can a script find a wild card name? So if I want to delete "Flowers sent to ***", that was whatever name is there, the entire sentence can be deleted?

 

[NeoSez]

This should work to extract the dates from the text. Below is an example of VBA works with Regular Expressions. You must adapt it for the ranges and strings in your workbook.

Sub FindAndCopyDate()

    Dim RegEx As RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strOutput As String
    Dim objMatches As Object
    Dim i As Long
    Dim rng As Range

    Set RegEx = New RegExp
    RegEx.Global = True
    RegEx.IgnoreCase = True

    'Set the RegEx pattern to find the date string within the input string
    RegEx.Pattern = "([a-z]{3} \d{1,2}, \d{4})"

    'Set the range of input string cells
    Set rng = Sheet1.Range("A2:A5")

    For i = 0 To rng.Count - 1
        strInput = Sheet1.Range("A2").Offset(i, 0).Value
   
        ' Find all matches of pattern in input string
        Set objMatches = RegEx.Execute(strInput)

        ' Returning only the first value found in the input string
        strOutput = objMatches(0).Value
        Sheet1.Range("A2").Offset(i, 1).Value = CDate(strOutput)
    Next i

End Sub

Thank you for the script @duggie33 . I am going to try your script. However, I am wondering where I would insert the text I want to find? For example, if I want to find "My dog has fleas" and then delete the date preceding it, where would I insert that into the script?