VBA - Record date of month as day of week

[Tony]

I have the following spreadsheet where I have to VBA code the cell with the
first day of the month with the corresponding day of the first week in row 3
using the recorded month as a reference point. For example April 1st of this
year fell on the Weds in the first Week.

April
A B C D E F G 1 M T W TH F M T 2 1

Can someone help out with some code? I am learning how to code VBA through
this site, but this one seems to be more difficult than I can do.

 

[joel]

Can you explain a little better. We can't tell from your posting where any
of the data is located.

 

[Tony]

Sorry, The month (April) will be placed into cell A1. The days of week will
start in cell B1 (M), B2 (T), B3(W), B4(TH), B5(F), B6 (M), B7 (T), etc. The
day of the month will be programmed into C1, C2, C3, etc depending on which
day of the first week it corresponds with.

So if A1 = April, and April 1st falls on the first Weds of the month, then
cell C3 would be equal to one (1). Hope this makes sense. I have a word
document that shows that shows the formatting better. If you would like an
email, let me know and I will send you my address.

 

[joel]

Your request is much more complicated then you expected.


Sub MakeCalendar()

DayArray = Array("M", "T", "W", "TH", "F")

Do
GoodDate = True
MyDate = Trim(InputBox("Enter month and year (MM/YYYY) : "))
If InStr(MyDate, "/") > 0 Then
MyMonth = Left(MyDate, InStr(MyDate, "/") - 1)
MyYear = Mid(MyDate, InStr(MyDate, "/") + 1)
If IsNumeric(MyMonth) And IsNumeric(MyYear) Then
MyMonth = Val(MyMonth)
MyYear = Val(MyYear)
If MyMonth > 0 And MyMonth <= 12 Then
If MyYear >= 0 And MyYear <= 10000 Then
StartDate = DateSerial(MyYear, MyMonth, 1)
'end date is the first day of next month - 1
If MyMonth = 12 Then
EndDate = DateSerial(MyYear + 1, 1, 1) - 1
Else
EndDate = DateSerial(MyYear, MyMonth + 1, 1) - 1
End If
Else
GoodDate = False
End If
Else
GoodDate = False
End If
Else
GoodDate = False
End If

Else
GoodDate = False
End If
If GoodDate = False Then
MsgBox ("Bad Date, enter again")
End If
Loop While GoodDate = False

'Enter Month in A1
Range("A1") = Format(StartDate, "MMMM")

FirstDate = False
LastDate = False
RowCount = 1
DateCount = StartDate
LastDay = Day(LastDate)
For Weeks = 1 To 5
For Days = 1 To 7
DayOfWeek = Weekday(DateCount, vbMonday)
If DayOfWeek = Days Then
FirstDate = True
End If
If DayOfWeek <= 5 Then
Range("B" & RowCount) = DayArray(Days - 1)
If FirstDate = True And LastDate = False Then
Range("C" & RowCount) = Day(DateCount)
End If
RowCount = RowCount + 1
End If

If DateCount = EndDate Then
LastDate = True
End If
If FirstDate = True Then
DateCount = DateCount + 1
End If
Next Days
Next Weeks


End Sub

 

[Tony]

Joel this works great. How would I change the code to record the day of the
week and the corresponding day in consecutive columns instead of consecutive
rows.

 

[joel]

Sub MakeCalendar()

DayArray = Array("M", "T", "W", "TH", "F")

Do
GoodDate = True
MyDate = Trim(InputBox("Enter month and year (MM/YYYY) : "))
If InStr(MyDate, "/") > 0 Then
MyMonth = Left(MyDate, InStr(MyDate, "/") - 1)
MyYear = Mid(MyDate, InStr(MyDate, "/") + 1)
If IsNumeric(MyMonth) And IsNumeric(MyYear) Then
MyMonth = Val(MyMonth)
MyYear = Val(MyYear)
If MyMonth > 0 And MyMonth <= 12 Then
If MyYear >= 0 And MyYear <= 10000 Then
StartDate = DateSerial(MyYear, MyMonth, 1)
'end date is the first day of next month - 1
If MyMonth = 12 Then
EndDate = DateSerial(MyYear + 1, 1, 1) - 1
Else
EndDate = DateSerial(MyYear, MyMonth + 1, 1) - 1
End If
Else
GoodDate = False
End If
Else
GoodDate = False
End If
Else
GoodDate = False
End If

Else
GoodDate = False
End If
If GoodDate = False Then
MsgBox ("Bad Date, enter again")
End If
Loop While GoodDate = False

'Enter Month in A1
Range("A1") = Format(StartDate, "MMMM")

FirstDate = False
LastDate = False
ColCount = 1
DateCount = StartDate
LastDay = Day(LastDate)
For Weeks = 1 To 5
For Days = 1 To 7
DayOfWeek = Weekday(DateCount, vbMonday)
If DayOfWeek = Days Then
FirstDate = True
End If
If DayOfWeek <= 5 Then
Cells(2,ColCount) = DayArray(Days - 1)
If FirstDate = True And LastDate = False Then
Cells(3,ColCount) = Day(DateCount)
End If
ColCount = ColCount + 1
End If

If DateCount = EndDate Then
LastDate = True
End If
If FirstDate = True Then
DateCount = DateCount + 1
End If
Next Days
Next Weeks