Creating a Macro for deleting entries falling on Weekends

[UFGATORS]

I need to create a macro for deleting entries falling on Weekends. I have a conditional formatting formula that colors the cells falling on Weekends "=WEEKDAY(L2:AP2,2)>5. So, I would need the macro to be able to delete entries from coloumn 3 to 799 if L2:AP2 is a Weekend day. Thank you in advance for any assistance.

 

[JackDanIce]

What is the name of the sheet the data is on?
What column contains the date being evaluated if it's a weekday or not?
What is the last row used?
Does row 1 contain the headers?

Finally, have you tried to use a helper column with a similar formula to your conditional formatting, filter for values > 5 and then delete visible rows?

 

[UFGATORS]

The name of the sheet is the month being tracked "May 2018", "Jun 2018" etc..
The dates are in cells L2:AP2
The data to be removed is in rows 3 to 799
Row 1 does have a header but there are no headings for columns L through AP
Also, I did have a typo in my original post where I said column 3 to 799 should have read row 3 to 799.

Let me try and explain again what I'm looking for. L3:AP3 contain the dates, so if a date falls on a weekend I won't to be able to have a macro that will remove all entries from row 3 to 799. Example if N3 and O3 is a weekend I want to be able to run a macro to have the data removed from those columns from row 3 to 799.

 

[JackDanIce]

Just to clairfy:

The dates are in cells L2:AP2

Then later

L3:AP3 contain the dates

I'm assuming dates are in row 2, and will action on what ever sheet is currently active (so you'll need to select the sheets you want to remove columns form before hand). As such, try:

Sub RemoveWeekends()

    Dim x       As Long
    Dim arr()   As Variant
    
    Application.ScreenUpdating = False
    
    'Col_L = 12, Col_AL = 42
    'Change red 2 if dates are in a different row
    arr = ActiveSheet.Cells(2, 12).Resize(, 31).Value

    For x = LBound(arr, 2) To UBound(arr, 2)
        If Weekday(arr(1, x), 2) > 5 Then arr(1, x) = vbNullString
    Next x

    With ActiveSheet.Cells(2, 12).Resize(, 31)
        .Value = arr
        .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete shift:=xlToRight
    End With
    
    Application.ScreenUpdating = True
    
    Erase arr
End Sub

 

[UFGATORS]

Sorry for my stupidity, you are correct the dates are on row 2 L2:AP2. The macro you created removed those day's instead of the data contained in the cells. The macro needs to keep the date on line 2 and the columns below the dates but just remove the data in the cells while keeping the formatting stopping at line 799. Example, if the date in cell L2 was a weekend, the macro would remove all data from L3:L799. I did not as this originally, but I also have a named range for "holidays" could the macro also remove the data on those days as well. Thank you so much for your assistance it is deeply appreciated.

 

[JackDanIce]

Try:

Sub RemoveWeekends()

    Dim x       As Long
    Dim y       As Long
    Dim arr()   As Variant
    
    Application.ScreenUpdating = False
    
    arr = ActiveSheet.Cells(2, 12).Resize(798, 31).Value

    For y = LBound(arr, 2) To UBound(arr, 2)
        If Weekday(arr(1, y), 2) > 5 Then
            For x = LBound(arr, 1) + 1 To UBound(arr, 1)
                arr(x, y) = vbNullString
            Next x
        End If
    Next y

    ActiveSheet.Cells(2, 12).Resize(798, 31).Value = arr
    
    Application.ScreenUpdating = True
    
    Erase arr
       
End Sub

I also have a named range for "holidays" could the macro also remove the data on those days as well.

Probably, without detail such as sheet name it's on or cell range it's found in, difficult to guess how to incorporate this into the code.

Pretend anyone reading this thread can't see your PC screen or spreadsheet, what information would help them solve your issue?

 

[UFGATORS]

That worked perfectly. The sheet name where the named range is located is on the same sheet as the data, the range of the holiday list is B991:B1080. Thank you so much for developing this code for me.

 

[Rick Rothstein]

That worked perfectly. The sheet name where the named range is located is on the same sheet as the data, the range of the holiday list is B991:B1080. Thank you so much for developing this code for me.

This is a different approach than Jack took (doable because the cells in range L1:AP1 are empty), but I believe it will do what you want including fo the holidays.

[table="width: 500"]
[tr]
	[td]Sub ClearWeekendsAndHolidays()
  Range("L1:AP1") = Evaluate("IF((WEEKDAY(L2:AP2,2)>5)+ISNUMBER(MATCH(L2:AP2,B991:B1080,0)),""X"","""")")
  Intersect(Range("L1:AP1").SpecialCells(xlConstants).EntireColumn, Rows("3:799")).ClearContents
  Range("L1:AP1").Clear
End Sub[/td]
[/tr]
[/table]

 

[JackDanIce]

Try:

Sub RemoveWeekends()

    Dim x       As Long
    Dim y       As Long
    Dim arr()   As Variant
    Dim dic     As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        arr = .Cells(991, 2).Resize(90).Value
        .Cells(991, 2).Resize(90).Select
        For x = LBound(arr, 1) To UBound(arr, 1)
            If LenB(arr(x, 1)) Then dic(arr(x, 1)) = x
        Next x
        
        arr = .Cells(2, 12).Resize(798, 31).Value
        
        For y = LBound(arr, 2) To UBound(arr, 2)
            If Weekday(arr(1, y), 2) > 5 Or dic.exists(arr(1, y)) Then: For x = LBound(arr, 1) + 1 To UBound(arr, 1): arr(x, y) = vbNullString: Next x
        Next y
        
        .Cells(2, 12).Resize(798, 31).Value = arr
    End With
    
    Application.ScreenUpdating = True
    
    Erase arr
    Set dic = Nothing
    
End Sub

Although @Rick Rothstein's is shorter and easier to manage, I'd use that!

 

[UFGATORS]

Thanks Rick, however I do have formulas in AJ1:AP1 that identify the EOM. Can you modify your code to account for this? So if possible I would like for row 1 not to be effected. Thank you.