VBA Check Date within a Name Range List and delete the row if it matches

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
245
Office Version
  1. 2019
Platform
  1. Windows
Thanks in advance for your assistance.

How can I get the code to delete any row with a date in Column B that is contained in the name range “Holidays”?

In a series of dates in a column (Column B) starting in row 7 of sheet “WL.Menu”, I would like to delete any date that falls on a weekend or holiday. The holidays or in another sheet “Name.Ranges” where they are Globally (Workbook) named (name range) “Holidays”.

I check the weekend with the function Weekday and the code is as follows and works. No issues there.
VBA Code:
If Weekday(WL_Date) = 7 Or Weekday(WL_Date) = 1 Then
Rows(i).EntireRow.Delete

The issue is with the holidays. I developed a function to check if the date within “WL.Menu” is within “Holidays”, but it never gives indication if the date is within the name range “Holidays”. I believe the issue is with the date format as when use a number “1” and format it as general it works.

The code is as follows:
VBA Code:
Sub WL_Insert()

'________________________________________________________________________________________________________
'01. Turn off alerts, screen updates, and automatic calculation
    'Activate Workbook
        'Workbooks(“ACT - Watchlist, Historical - " & "(" & "Active" & ")").Activate
    
    'Turn off Display Alerts
        Application.DisplayAlerts = False

    'Turn off Screen Update
        Application.ScreenUpdating = False

    'Turn off Automatic Calculations
        Application.Calculation = xlManual


'________________________________________________________________________________________________________
'02. Dimensioning
    
    'Dimensioning Long
        Dim i As Long
        Dim LastRow As Long
        Dim LastRowColA As Long
        Dim LastRow_Val As Long
        Dim LastRow_Val1 As Long
        Dim LastRow_Val2 As Long
        
        Dim Count As Long
        
        Dim ColNum As Long
        
        Dim Sht_Start As Long
        Dim Sht_End As Long
                    
                    
    'Dimensioning Sheets
        Dim Sht_Place As Worksheet
    
    
    'Dimensioning Words/Strings
        Dim WL_Date As String
        Dim SheetName As String
        
        Dim Date_Holiday As String
        

'________________________________________________________________________________________________________
'03. Activate the Watch List Menu tab "WL.Menu", find the last row within column B
        
    'Activate the StockList sheet
        Sheets("WL.Menu").Activate
            
    'Set SheetName to "WL.Menu" and column number to 1 so it can find the last row
        
        SheetName = "WL.Menu"
        
        ColNum = 2
        LastRow_Val1 = LastRowColF(SheetName, ColNum)

    '___________________________
        'Delete any weekends and holidays

            For i = LastRow_Val1 To 7 Step -1

                WL_Date = Range("B" & i).Value
                Date_Holiday = Date_HolidayF(WL_Date)
                
                MsgBox WL_Date
                MsgBox Weekday(WL_Date)
                MsgBox Date_Holiday
                
                Sheets("WL.Menu").Activate
                
                If Weekday(WL_Date) = 7 Or Weekday(WL_Date) = 1 Then
                    Rows(i).EntireRow.Delete
                    
                ElseIf Date_Holiday = "Yes" Then
                    Rows(i).EntireRow.Delete
            
                End If

            Next i
    
    
    
    '___________________________
        'Find the last row of all dates and then the last row for the sheets that exist already
            ColNum = 2
            LastRow_Val1 = LastRowColF(SheetName, ColNum)
        
            ColNum = 4
            LastRow_Val2 = LastRowColF(SheetName, ColNum) + 1       'starts with the first blank entry


        
    '___________________________
            
        Set Sht_Place = Sheets("WL.START")
        
        If Range("A" & LastRow_Val2 - 1).Value = "NO." Then
            Count = 0
            
        Else
            Count = Range("A" & LastRow_Val2 - 1).Value
            
        End If
        
            
        With Sht_Place
            For i = LastRow_Val2 To LastRow_Val1
            
                'Inserts the WL number in column A
                    
                    Cells(i, 1) = Count + 1
                    Count = Count + 1
                
                'Inserts the Tab Name into Column C
                    Cells(i, 3) = Format(Cells(i, 2), "YYYY.MM.DD")
                                        
                'Inserts the word "Current" in column D
                    Cells(i, 4).Value = "Current"
                
                
                'Check if the sheet exists:
                    SheetName = Cells(i, 3).Value
                    Exist = FSheetExists(SheetName)
                    
                'If then Condition to make sheet if it does not exist
                    If Exist = "No" Then

                        'Make the Sheet
                            WL_Date = Sheets("WL.Menu").Cells(i, 3).Value
                            Sheets("WL.Template").Activate
                            ActiveSheet.Copy After:=Sht_Place
                            ActiveSheet.Name = WL_Date
                    
                        'Format(WL_Date, "YYYY.MM.DD")
                            Sheets(WL_Date).Range("C6").Select
                            Sheets(WL_Date).Tab.Color = 13434879
                            Set Sht_Place = Sheets(WL_Date)
                
                        'Sets the hyperlink in the "WL.Menu" Tab
                            Sheets("WL.Menu").Activate
                            Range("C" & i).Select
                            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _
                            SubAddress:=WL_Date & "!A7"
                                        
                        'Sets
                            Sheets("WL.Menu").Cells(i, 3).HorizontalAlignment = xlCenter
                            
                        Else
                        
                    End If
                                    
                Next i

            End With
            
            
    'Arrange the sheets in decending order
        Sht_Start = Worksheets("WL.START").Index
        Sht_End = Worksheets("WL.END").Index
                        
        For i = Sht_Start + 1 To Sht_End - 1
            For j = Sht_Start + 1 To Sht_End - 2
                If UCase$(Application.Sheets(j).Name) < UCase$(Application.Sheets(j + 1).Name) Then
                    Sheets(j).Move After:=Sheets(j + 1)
                End If
            Next
        Next


'________________________________________________________________________________________________________
'Format the columns
    
    'Activate the "WL.Menu" tab
        Worksheets("WL.Menu").Activate
        
    'Format column A
        Range("A7:A" & LastRow_Val1).Select
        Range("A7:A" & LastRow_Val1).HorizontalAlignment = xlLeft
        
    'Format column B
        Range("B7:B" & LastRow_Val1).Select
        Range("B7:B" & LastRow_Val1).NumberFormat = "YYYY-MM-DD, DDD"
        Range("B7:B" & LastRow_Val1).HorizontalAlignment = xlLeft
        
    'Format column C
        Range("C7:C" & LastRow_Val1).Select
        Range("C7:C" & LastRow_Val1).HorizontalAlignment = xlCenter
        
    'Format Column D
        Range("D7:D" & LastRow_Val1).Select
        Range("D7:D" & LastRow_Val1).HorizontalAlignment = xlCenter
        

'________________________________________________________________________________________________________
'Select the cell for the cursor to rest
    
    
    Range("C" & LastRow_Val1).Select
    

'________________________________________________________________________________________________________
'Turn on alerts, screen updates, and calculate

        'Turn On Display Alerts
            Application.DisplayAlerts = True

        'Turn on Screen Update
            Application.ScreenUpdating = True

        'Turn off Automatic Calculations
            Calculate
        

End Sub

The functions used are:

LastRow_Val1 = LastRowColF(SheetName, ColNum)
VBA Code:
****************************************************************************************************
'This function finds the last row within a worksheet/tab for a particular column
Function LastRowColF(ByVal SheetName As String, ByVal ColNum As Long) As Long
    Dim WkS As Worksheet
    Set WkS = ActiveWorkbook.Worksheets(SheetName)
    LastRowColF = WkS.Cells(Rows.Count, ColNum).End(xlUp).Row
End Function

Date_Holiday = Date_HolidayF(WL_Date)
VBA Code:
'****************************************************************************************************
'This function checks if the date is a holiday

Function Date_HolidayF(WL_Date As String) As String
    
    'Dimesioning
        Dim Stocks_Sheet As Worksheet
    
        Dim Search_Range As Range
        Dim Find_Range As Range
    
    'Activate the Stock Sheet and Search for the date
        Sheets("Name.Ranges").Activate
        Set Search_Range = Range("Holidays")
        Set Find_Range = Search_Range.Find(What:=WL_Date, LookIn:=xlValues, LookAt:=xlWhole)
                
    'Logic if the date is a Holiday or not
        If Find_Range Is Nothing Then
            Date_HolidayF = "No"

        Else
            Date_HolidayF = "Yes"
                        
        End If
        
End Function


Checks to see if the Sheet Exists:
VBA Code:
Function SheetExistsF(SheetName As String) As String
    
    'Dimensioning
        Dim Obj As Object
    
    On Error GoTo HandleError
    Set Obj = Worksheets(SheetName)
    FSheetExists = "Yes"
    Exit Function
HandleError:
    FSheetExists = "No"
    
   
End Function
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
1,655
Office Version
  1. 365
Platform
  1. Windows
Using Find with dates is really tricky.
It works differently depending on whether the dates are constants or formulas.
And in both cases, date formats come into play with lookin:=xlvalues being the most exacting in its requirements.

What about using something along the lines of the below:-
VBA Code:
Sub findDate()

    Dim cellref As String
    Dim findRow As Long
    Dim resMatch As Variant
   
    cellref = "E6"
   
    resMatch = Application.Match(Range(cellref), Range("Holidays"), 0)

    If Not IsError(resMatch) Then
        MsgBox "found"
    Else
        MsgBox "not found"
    End If
   
End Sub
 

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
245
Office Version
  1. 2019
Platform
  1. Windows
Using Find with dates is really tricky.
It works differently depending on whether the dates are constants or formulas.
And in both cases, date formats come into play with lookin:=xlvalues being the most exacting in its requirements.

What about using something along the lines of the below:-
VBA Code:
Sub findDate()

    Dim cellref As String
    Dim findRow As Long
    Dim resMatch As Variant
  
    cellref = "E6"
  
    resMatch = Application.Match(Range(cellref), Range("Holidays"), 0)

    If Not IsError(resMatch) Then
        MsgBox "found"
    Else
        MsgBox "not found"
    End If
  
End Sub

Thanks @Alex Blakenburg

Curious why did you set?

VBA Code:
cellref = "E6"
 

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
1,655
Office Version
  1. 365
Platform
  1. Windows
I just needed a test value that I could easily change to test found and not found so I put it in E6.
I am glad you asked though the conversion to using your string WL_Date wasn't as straight forward as I imagined.

I think the following should work in your function:-
VBA Code:
resMatch = Application.Match(CLng(CDate(WL_Date)), Range("Holidays"), 0)
 

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
245
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

I just needed a test value that I could easily change to test found and not found so I put it in E6.
I am glad you asked though the conversion to using your string WL_Date wasn't as straight forward as I imagined.

I think the following should work in your function:-
VBA Code:
resMatch = Application.Match(CLng(CDate(WL_Date)), Range("Holidays"), 0)
Before you respond. Give me a second as I think I am now able to figure it out.

Previously I wrote:

Thanks. That clarified it. So I input the code and I had three dates to check and it said "not found" one time where there were two dates within "Holidays".

In your code:
--> you use WL_Date, but I do not have that defined as a name range and you do not have it defined as anything. Does that need to be defined?
--> You change the WL_Date to "CDate" and then CLng, but the "Holidays" are not changed. Will this still work even if the WL_Date becomes defined?

Thanks!
 
Last edited:

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
1,655
Office Version
  1. 365
Platform
  1. Windows
--> you use WL_Date, but I do not have that defined as a name range and you do not have it defined as anything. Does that need to be defined?
You have it defined here:-
Function Date_HolidayF(WL_Date As String) As String

So you are passing a date as string to the function.

--> You change the WL_Date to "CDate" and then CLng, but the "Holidays" are not changed. Will this still work even if the WL_Date becomes defined?
Presumably the values in holidays are dates, so all we are doing it converting WL_Date into a format that works when looking for dates in the worksheet.
 

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
245
Office Version
  1. 2019
Platform
  1. Windows
Thanks so much. I modified your solution a bit to work for my needs and it worked perfect. I will now attempt to modify my main code to see if it works. Thanks!


VBA Code:
Sub findDate()

    'Dimensioning
        Dim findRow As Long
        Dim resMatch As Variant
       
        Dim WL_Date As String
        Dim LastRow_Val1 As Long
        Dim ColNum As Long
        Dim i As Long
   
   
    'Activate Sheet
        Sheets("WL.Menu").Activate
   
    'LastRow
        SheetName = "WL.Menu"
        ColNum = 2
        LastRow_Val1 = LastRowColF(SheetName, ColNum)
   
    'Loop to check for Holidays
        For i = LastRow_Val1 To 7 Step -1
   
            WL_Date = Range("B" & i).Value
  
            resMatch = Application.Match(CLng(CDate(WL_Date)), Range("Holidays"), 0)

            If Not IsError(resMatch) Then
                MsgBox "found"
            Else
                MsgBox "not found"
            End If
       
        Next i
 
End Sub

The function I have for the last row is as follows:
VBA Code:
****************************************************************************************************
'This function finds the last row within a worksheet/tab for a particular column
Function LastRowColF(ByVal SheetName As String, ByVal ColNum As Long) As Long
Dim WkS As Worksheet
Set WkS = ActiveWorkbook.Worksheets(SheetName)
LastRowColF = WkS.Cells(Rows.Count, ColNum).End(xlUp).Row
End Function
 
Solution

Forum statistics

Threads
1,140,999
Messages
5,703,639
Members
421,307
Latest member
morrden86

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
Top