PDA

View Full Version : Solved: Finding Specific Days In a Year



Bopo2
10-28-2009, 10:00 AM
Hey guys, just a quick query I have. Basically I was wondering if there's a function to find all the weekends (Saturdays & Sundays).
As you can see from my printscreen, I'd like something to figure out what days are Saturdays and Sundays and insert or change the fill for example,
just some sort of indication.

Many thanks

P.S. here's a print screen of my calendar so give you a better idea about what I'm trying to achieve.


img524.imageshack.us/img524/3336/calendarprintscreen.png

RolfJ
10-28-2009, 11:16 AM
I am not aware of a function that would do, but until sombody comes up with one, I can offer you a macro that might point you in the right direction if nothing else. Given that you enter the year you are interested in in cell B1, this macro will list the dates of all weekends for that year in column A from cell A3 down:


Sub FindAllWeekendsInYear()
Dim y As Integer
y = Range("B1").Value
Dim d As Date
d = DateSerial(y, 1, 1)
Dim nWeekendDays As Integer
Do
If Weekday(d, vbSunday) = 7 Or Weekday(d, vbSunday) = 1 Then
Range("A3").Offset(nWeekendDays).Value = d
nWeekendDays = nWeekendDays + 1
End If
d = DateAdd("d", 1, d)
If Year(d) = y + 1 Then Exit Do
Loop
End Sub


Hope this helped at least somewhat,
Rolf

Bob Phillips
10-28-2009, 12:40 PM
How about

RolfJ
10-29-2009, 06:53 AM
THANKS for reminding us at simplicity!
Best wishes.

Bopo2
10-29-2009, 08:45 AM
Thanks for the replies, xld have you manually created the calender above and colored the weekends? Because I can't find anything that would indicate some sort of automation, totally confused :).

GTO
10-29-2009, 11:50 PM
Hi Bopo,

Since we cannot see the picture, its a bit unclear as to what you want, so please forgive if this is note in the right direction.

In a blank/new wb (just to test), add a Standard Module and run:

Option Explicit

Const POINTS2FONT As Double = 5.69395017793594

Sub exa()
Dim rngCal As Range
Dim wks As Worksheet
Dim x As Long, y As Long
Dim i As Long, lCnt As Long

Dim Size As Double: Size = 20

For i = 1 To 12
Set wks = Worksheets.Add
wks.Name = MonthName(i, True)

With wks
.Cells.RowHeight = Size
.Cells.ColumnWidth = (Size / POINTS2FONT) * 3

Set rngCal = .Range("B2").Resize(7, 7)

With rngCal
.BorderAround xlContinuous, xlThick, 1
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlMedium
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
With .Rows(1)
.Value = Array("MO", "TU", "WE", "TH", "FR", "SA", "SU")
.Font.Bold = True
End With

Set rngCal = rngCal.Offset(1).Resize(6)
rngCal.HorizontalAlignment = xlLeft

x = 1: y = Weekday(DateSerial(Year(Date), i, 1), vbMonday): lCnt = 1
Do
rngCal(x, y).Value = lCnt
If y = 6 Or y = 7 Then rngCal(x, y).Interior.ColorIndex = 15

If y = 7 Then
x = x + 1
y = 1
Else
y = y + 1
End If
lCnt = lCnt + 1
Loop While lCnt <= Day(DateSerial(Year(Date), i + 1, 1) - 1)
End With
End With
Next
End Sub


Is that anything like what you are trying to do with your calendar?

Mark

p45cal
10-30-2009, 02:11 AM
Thanks for the replies, xld have you manually created the calender above and colored the weekends? Because I can't find anything that would indicate some sort of automation, totally confused :).
Look at the Conditional Formatting. Try changing the year in A1.