PDA

View Full Version : Checking if date is weekend



wakwak1
01-12-2008, 05:25 PM
In column A I have dates starting from 20070420 (yyyymmdd format) and if this date is a weekend I need VBA to delete all data in the same row going from column B to column O. Thanks !!

rlv
01-12-2008, 10:03 PM
The =WEEKDAY() function will tell you the day of the week. You could build a UDF around this to test your dates for weekends.

''' Assumes MyDate is an Excel date serial number
Function IsWeekendDay(MyDate As Variant) As Boolean

Dim DayNum As Variant
Dim IsWeekend As Boolean

DayNum = Application.WeekDay(MyDate)
If Not IsError(DayNum) Then
Select Case DayNum
Case 2 To 6 ' Monday thru Friday
IsWeekend = False
Case Else
IsWeekend = True
End Select
Else
IsWeekend = False ' error
End If
IsWeekendDay = IsWeekend
End Function

mikerickson
01-12-2008, 11:23 PM
This uses AdvancedFilter.
I understood "delete all data in the same row going from column B to column O" to mean clear the contents of those cells.
It also assumes that the entries in columnA are numbers. i.e. 20070420 rather than the serial date for 20. Apr 2007.

I hope it works for you.

Sub Macro1()
Dim dataRay As Range
Dim criteriaPlace As Range, columnAddress As String
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("sheet1")
columnAddress = "A1:O1"
.Range(columnAddress).Insert shift:=xlDown
Set dataRay = .Range(columnAddress)
dataRay.FormulaR1C1 = "=""Header"" & COLUMN()"
Set dataRay = dataRay.Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, dataRay.Columns.Count)
With .UsedRange
Set criteriaPlace = .Cells(1, dataRay.Columns.Count + .Column + .Columns.Count + 1).Resize(2, 1)
criteriaPlace.Range("A2").FormulaR1C1 = _
"=(MOD(WEEKDAY(DATEVALUE(MID(RC1,5,2) & ""/"" & MID(RC1,7,2) & ""/"" & LEFT(RC1,4))),6)=1)"
End With
dataRay.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=criteriaPlace, Unique:=False
End With
With dataRay
Application.Intersect(dataRay.Offset(1, 1), .SpecialCells(xlCellTypeVisible)).ClearContents
On Error Resume Next
.Parent.ShowAllData
On Error GoTo 0
End With
criteriaPlace.Delete shift:=xlUp
dataRay.Rows(1).Delete shift:=xlUp
Application.ScreenUpdating = True
End Sub