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

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
Code:
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.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Do not store dates as text but just use the VBA function CDate to convert your textbox input to a cell …​
 
Upvote 0
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.
 
Upvote 0
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:
This is how I got it to work, taking inspiration from @BSALV 's solution.
Code:
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
 
Upvote 0
Solution

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top