VBA AdvancedFiltering faling to work after changing the format of cells.

[kelly mort]

Sub filterDate()
    sh.[O2] = "=COUNTIF(E4:N4,TODAY())=0"
    Application.ScreenUpdating = False
    
    lr = sh.Range("B" & Rows.Count).End(xlUp).Row
    If lr < 3 Then lr = 3
    
    With sh.Range("B3:N" & lr)
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=sh.[O1:O2], Unique:=False
        .Offset(1).ClearContents '.EntireRow.Delete
        If .Parent.FilterMode Then .Parent.ShowAllData
    End With
    Application.ScreenUpdating = True
End Sub

I have been using this code (written for me by one of the experts here) to filter data for the present day (today).
It's working fine but the issue I have is with my dates.

I enter dates as dd-mm-yy (textbox input) and send it to my Worksheet.
It has been working cool until I start to notice that some of the dates change after sending them to the sheet (which I think could be as a result of how the system date format is).

For example, when I enter 12-01-22, it enters the sheet as 01-12-22.

So I decided to format the date columns on the sheet as texts so that I store the dates as texts instead (which stay unchanged).
And doing so, prevented the above code from working as before.

How do I get it back online?

Thanks in advance.

 

[Marc L]

​

Do not store dates as text but just use the VBA function CDate to convert your textbox input to a cell …​

 

[kelly mort]

​

Do not store dates as text but just use the VBA function CDate to convert your textbox input to a cell …​

That's what I have been doing (CDate). But when I send the data to the cell, it changes it format.

It mostly happen when entering dates for January. I have tried all workarounds but none seemed reliable enough - the reason I want to store it as text since that is stable.

But I will still take time and run the CDate test again to see what comes out.

 

[kelly mort]

I managed to get a script which I used to compare the text dates and then copy data instead of the advanced Filter option as used in the code I posted before.

In a related post which deals with a range of dates, posted at:

VBA code to list the individual dates between two dates

In the post at: https://www.mrexcel.com/board/threads/vba-advancedfiltering-faling-to-work-after-changing-the-format-of-cells.1192601/ I was looking for a way around getting advanced Filter to work for dates stored as texts in the format "dd-mm-yy". According to @Marc L, it is not a good idea to...

www.mrexcel.com

This is how I got it to work, taking inspiration from @BSALV 's solution.

Option Explicit
Sub TestDates()
    Dim dfDate&
    Dim i&, dNew$, dLast$, d$, m$, y$, mNext&, fEnd As Boolean
    Dim uInput, sp, esp, dSt&, dEn&, dlEnd$, mLast&, dRng As Range
    
    uInput = "01-01-21,01-01-22"
    sp = Split(uInput, ",")
    
    dfDate = DateDiff("d", DateValue(sp(0)), DateValue(sp(1))) + 1
    
    If dfDate > 366 Then
        MsgBox "We cant handle " & dfDate & " days!!!", vbExclamation
        Exit Sub
    End If
    
    esp = Split(sp(0), "-")
    m = esp(1)
    y = esp(2)
    dLast = sp(1)
    dlEnd = ""
    dEn = 31
    dSt = Val(esp(0))
    
    Range("A1:A1000").ClearContents
    
    Select Case Val(esp(1))
        Case 2
            dEn = 28
            If esp(2) Mod 4 = 0 Then dEn = 29
        Case 4, 6, 9, 11
            dEn = 30
    End Select
    
    Application.ScreenUpdating = False
    
    While dLast <> dlEnd
        fEnd = False
        For i = dSt To dEn
            Set dRng = Cells(Rows.Count, "A").End(xlUp).Offset(1)
            d = Format(i, "00")
            dNew = d & "-" & m & "-" & y
            dRng = dNew
            If i = dEn Then
                mLast = Val(m)
                If dNew = dLast Then
                    dlEnd = dNew
                    fEnd = True
                End If
            End If
            If dNew = dLast Then
                dlEnd = dNew
                fEnd = True
                Exit For
            End If
        Next i
        
        If Not fEnd Then
            dSt = 1
            dEn = 31
            y = esp(2)
            mNext = mLast + 1
            
            If mLast = 12 Then
                If Right(sp(0), 2) <> Right(sp(1), 2) Then
                    y = Right(sp(1), 2)
                    mNext = 1
                End If
            End If
            
            m = Format(mNext, "00")
            
            Select Case mNext
                Case 2
                    dEn = 28
                    If y Mod 4 = 0 Then dEn = 29
                Case 4, 6, 9, 11
                    dEn = 30
            End Select
        End If
    Wend
    Application.ScreenUpdating = True
End Sub