Remove all dates from a text string older than...

[Greasle]

Hi all,

I'm logging events in a Table. A column called "log" (F column) collects all dates when certain events happened. (Every row has its own event) Below you see the content of a cell in this Column
The cell uses the text format.

24/07/17 -- 00/01/00 -- 00/01/00 -- 24/05/17 -- 23/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 20/05/17 -- 19/05/16 -- 19/05/16 -- 19/05/16 -- 19/04/15 -- 18/04/15 -- 04/03/15

The sheet is growing in size and i like have a script to remove all dates older than 2 years using VBA from this text string in each cell of the column keeping the format.

The 00/01/00 , within the string, is a error result what is the fiction date 0 January 1900 and has to be removed as well.

"Remove all dates from a text string older than... " but "remove the years 2015 and below" will do as well.





(I'm not a schooled coder and work mostly with a lot of copy/paste and try & error. In this case I tried starting with wild-card search en replace but stranded.)

 

[Greasle]

so:

24/07/17 -- 00/01/00 -- 00/01/00 -- 24/05/17 -- 23/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 20/05/17 -- 19/05/16 -- 19/05/16 -- 19/05/16 -- 19/04/15 -- 18/04/15 -- 04/03/15

has to become:

24/07/17 -- 24/05/17 -- 23/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 22/05/17 -- 20/05/17 -- 19/05/16 -- 19/05/16 -- 19/05/16

 

[ttray33y]

so meaning to say all these dates are in F column?

also, you date format is very odd, dd/mm/yy?

 

[Greasle]

so meaning to say all these dates are in F column?

also, you date format is very odd, dd/mm/yy?

yes
&
Yes

 

[Drew]

you can try this...

change code to suit sheet name and beginning cell ref in col F (this code starts on F5) .
I also added a cutoff date that you can use for as your 2 year cutoff. The code is referencing F2 (I used "31/12/15" in test) but you can put it anywhere on the sheet, just change the 'j' variable cell reference.

Also, please test as this code as it overrides your list... which is what I believe you wanted.

Sub ReduceString()
    Dim dt As Worksheet
    Dim a, b, i As Long, ii As Integer, z, j As String, k As Date, d As Date
    
    Application.Calculation = xlCalculationManual
    
    Set dt = Worksheets("Dates")
    
    a = dt.Range("f5:f" & dt.Cells(Rows.Count, "f").End(xlUp).Row).Value
    j = dt.Cells(2, "f")
    k = DateSerial(Right(j, 2), Mid(j, 4, 2), Left(j, 2))
    
    ReDim b(1 To UBound(a), 1 To 1)
    
    For i = 1 To UBound(a, 1)
        z = Split(a(i, 1), " -- ")
        For ii = 0 To UBound(z, 1)
            d = DateSerial(Right(z(ii), 2), Mid(z(ii), 4, 2), Left(z(ii), 2))
            If d >= k Then
                If ii = 0 Then
                    b(i, 1) = z(ii)
                Else
                    b(i, 1) = b(i, 1) & " -- " & z(ii)
                End If
            End If
        Next ii
        
    Next i
    
    dt.Cells(5, "f").Resize(UBound(b, 1)) = b
        
    Application.Calculation = xlCalculationAutomatic

End Sub

 

[Greasle]

Hi Drew,

This looks very creative.

I changes the correct sheet.

But still have a small error. A "[COLOR=var(--yt-primary-text-color)]VBA Run-Time Error '13' Type Mismatch" on[/COLOR]


k = DateSerial(Right(j, 2), Mid(j, 4, 2), Left(j, 2))



In the meantime i worked around to solve the problem using "Left" to reduce the size of the strings making the making the number of characters the trigger to reduce the growing file size. But this, based on dates, looks like a much better solution.