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.

 

[Rick Rothstein]

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.

In Message #3 you said "Row 1 does have a header but there are no headings for columns L through AP" which I took to mean that range L1:AP1 were empty. The following code assumes that range L800:AP800 is empty...

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

 

[UFGATORS]

Jack, the new macro works, however, on line one AJ1:AP1 I have the following formula entered "=IF(WORKDAY(EOMONTH($L$2,0)+1,-1,holidays)=AJ2,"EOM","")" that will place the EOM on the last workday of the month. I have another macro that creates a new month on a new tab, when I run the macro it is removing the above formula from AJ1:AP1. Prior to adding your macro this did not happen. Is there anything in your macro that is causing this. Other than this issue your code is working.

 

[Rick Rothstein]

Jack, the new macro works, however, on line one AJ1:AP1 I have the following formula entered "=IF(WORKDAY(EOMONTH($L$2,0)+1,-1,holidays)=AJ2,"EOM","")" that will place the EOM on the last workday of the month. I have another macro that creates a new month on a new tab, when I run the macro it is removing the above formula from AJ1:AP1. Prior to adding your macro this did not happen. Is there anything in your macro that is causing this. Other than this issue your code is working.

Just wondering... did you get to try the new code I posted in Message #11 yet?

 

[JackDanIce]

@UFGATORS small change to code in #9 and indicated what part of the sheet it's reading from/writing to; the code does not interact at all with row 1 of your active sheet and makes no changes to the values in L2:AP2.

I'd still advocate Rick's code on basis of being shorter

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
        'Read values from holidays range into dictionary
        arr = .Cells(991, 2).Resize(90).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            If LenB(arr(x, 1)) Then dic(arr(x, 1)) = x
        Next x
        
        'Read data from L2:AP799
        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

         'Write array to L2:AP799
        .Cells(2, 12).Resize(798, 31).Value = arr
    End With
    
    Application.ScreenUpdating = True
    
    Erase arr
    Set dic = Nothing
    
End Sub

 

[UFGATORS]

Hi Rick, yes it did work, I just had to change the range to end on line 799 as there is information on line 800. But it works perfect. Thank you so much for helping me.

 

[UFGATORS]

Thank you Jack for your help with this. As you suggested I ended up using Ricks code. Cheers.

 

[JackDanIce]

No worries, glad you have a working solution