calculating number of weeks in a month ( jan -Dec 13) starting every monday+display

Hi ,
I have spent days to figure out how do I calculate the week numbers. Well this is possible .
But is there any way, where it does the following:
1. Calculates current month weeks ( week starting on Monday)
2. Displays them in a column with their numbers and Month
3. Highlights the current week

Is it possible?

Regards

Place the Year (i.e. 2013 ) in "A1", Run code, Month names shown in column "A", "Monday" Dates shown in column "B".
If this is not exactly what you want, please show an example of your expected reaults.

Sub MG08May22
Dim LpYr        As Integer
Dim Dys         As Integer
Dim Dt          As Date
Dim n           As Integer
Dim nDt         As Date
Dim Ray()
LpYr = Month(DateSerial(2008, 2, 29))
    Dys = IIf(LpYr = 2, 366, 365)
        Dt = DateSerial([a1] - 1, 12, 31)
    
    For n = 1 To Dys
        nDt = DateAdd("d", n, Dt)
        If WeekdayName(Weekday(nDt, vbMonday)) = "Monday" Then
            c = c + 1
            ReDim Preserve Ray(1 To 2, 1 To c)
            Ray(1, c) = MonthName(Month(nDt))
            Ray(2, c) = nDt
        End If
    Next n
Range("A2:B2") = Array("Month", "Monday Dates")
Range("A3").Resize(c, 2) = Application.Transpose(Ray)
End Sub

Regards Mick

Hi,
This works fine . This is what I wanted.
Thanks again for your help
Regards

Your welcome
Regrds Mick