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

[OilEconomist]

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.

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:

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)

****************************************************************************************************
'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)

'****************************************************************************************************
'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:

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

 

[Alex Blakenburg]

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:-

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]

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:-

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?

cellref = "E6"

 

[Alex Blakenburg]

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:-

resMatch = Application.Match(CLng(CDate(WL_Date)), Range("Holidays"), 0)

 

[OilEconomist]

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:-

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!

 

[Alex Blakenburg]

--> 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]

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!

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:

****************************************************************************************************
'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

 

[Alex Blakenburg]

Sounds good. Let us know how you go.