-
I think this might be sufficient:
Code:
Sub M_cal()
For j = 0 To UBound(lbBills.List)
c00 = c00 & vbCrLf & Join(Application.Index(lbBills.List, j + 1), "|")
Next
sn = Split(c00 & vbCrLf, vbLf)
For j = 1 To 42
If j < 7 Then Me("sum" & j).Caption = ""
Me("dcell" & j).Clear
Me("dnum" & j).Caption = IIf(j < Weekday(DateSerial(sYear, sMonth, 1)) Or j > Weekday(DateSerial(sYear, sMonth, 1)) + Day(DateSerial(sYear, sMonth + 1, 0)) - 1, "", j - Weekday(DateSerial(sYear, sMonth, 1)) + 1)
If j Mod 7 = 6 Then Me("dnum" & j).Font.Bold = cb_paydays.Value
If Me("dnum" & j).Caption <> "" And UBound(Filter(sn, "|" & Me("dnum" & j).Caption & vbCr)) > -1 Then
Me("dcell" & j).List = Split(Join(Filter(Split(Join(Filter(sn, "|" & Me("dnum" & j).Caption & vbCr), "|~"), "|"), vbCr, False)), "~")
Me("sum" & (j - 1) \ 7 + 1).Caption = Val(Me("sum" & (j - 1) \ 7 + 1).Caption) + Evaluate("0+" & Join(Filter(Split(vbCr & Join(Filter(sn, "|" & Me("dnum" & j).Caption & vbCr), vbCr & "|" & vbCr), "|"), vbCr, False), "+"))
End If
Next
End Sub
Private Sub cb_paydays_Change()
M_cal
End Sub
BTW it's not a radiobutton (OptionButton) but a CheckBox.
-
Thank you snb,
I had worked out a routine for every friday as yours does (much more nicely than mine for sure)
I was stumped with every other friday.
I was able to mark every other friday starting from the first friday of each month,
but paydays I believe start the first friday of the year and are every other friday from there, which might be the second friday of some months instead of the first. So I came up with a test to see if the current month starts on an even or odd week number of the year, then I am trying to see how to apply that to the selected months week
here are the three sub's I have so far, I put them in a frame with option buttons to trigger ob_Fridays, ob_EoF, ob_BiMonth
Code:
Function WeekNum(DT As Date) As Long
WeekNum = Int(((DT - DateSerial(Year(DT), 1, 0)) + 6) / 7)
End Function
Sub addPayDay_BiMonth() ' bi monthly
'makes the 1st and the 15th of the month day captions Bold when the check box is active
Dim D, x As Integer
Dim myDate As Date
With ufCal
For x = 1 To 42
.Controls("dnum" & x).Font.Bold = False
Next x
myDate = .uMonth.Caption & "-1-" & .uYear.Caption
D = FirstWeekDayOfMonth(myDate) - 1
.Controls("dnum" & D + 1).Font.Bold = True
.Controls("dnum" & D + 15).Font.Bold = True
End With
End Sub
Sub addPayDay_fridays() ' every friday
'makes every friday day captions Bold when the radio button is active
Dim D, x As Integer
Dim myDate As Date
With ufCal
For x = 1 To 42
.Controls("dnum" & x).Font.Bold = False
Next x
For s = 6 To 41 Step 7
.Controls("dnum" & s).Font.Bold = True
Next s
End With
End Sub
Sub addPayDay_EoF() ' every friday
'makes every friday day captions Bold when the radio button is active
Dim D, s, x As Integer
Dim myDate As Date
With ufCal
For x = 1 To 42
.Controls("dnum" & x).Font.Bold = False
Next x
myDate = .uMonth.Caption & "-1-" & .uYear.Caption
D = FirstWeekDayOfMonth(myDate) - 1
If (WeekNum(myDate) Mod 2) = 0 Then
MsgBox ("EvenWeek")
For s = 12 To 41 Step 14
.Controls("dnum" & s).Font.Bold = True
Next s
Else
MsgBox ("OddWeek")
For s = 6 To 41 Step 14
.Controls("dnum" & s).Font.Bold = True
Next s
End If
End With
End Sub
-
Also your latest routine stopped at:
If j Mod 7 = 6 Then Me("dnum" & j).Font.Bold = cb_paydays.Value
I changed the end to True and it completed but marked every friday, where I was looking to do every other.
My goal is to have the three options listed in my last post that the user can select: Fridays, EoF, and BiMonthly.
Code:
Sub M_cal()
For j = 0 To UBound(lbBills.List)
c00 = c00 & vbCrLf & Join(Application.Index(lbBills.List, j + 1), "|")
Next
sn = Split(c00 & vbCrLf, vbLf)
For j = 1 To 42
If j < 7 Then Me("sum" & j).Caption = ""
Me("dcell" & j).Clear
Me("dnum" & j).Caption = IIf(j < Weekday(DateSerial(sYear, sMonth, 1)) Or j > Weekday(DateSerial(sYear, sMonth, 1)) + Day(DateSerial(sYear, sMonth + 1, 0)) - 1, "", j - Weekday(DateSerial(sYear, sMonth, 1)) + 1)
If j Mod 7 = 6 Then Me("dnum" & j).Font.Bold = True 'cb_paydays.Value
If Me("dnum" & j).Caption <> "" And UBound(Filter(sn, "|" & Me("dnum" & j).Caption & vbCr)) > -1 Then
Me("dcell" & j).List = Split(Join(Filter(Split(Join(Filter(sn, "|" & Me("dnum" & j).Caption & vbCr), "|~"), "|"), vbCr, False)), "~")
Me("sum" & (j - 1) \ 7 + 1).Caption = Val(Me("sum" & (j - 1) \ 7 + 1).Caption) + Evaluate("0+" & Join(Filter(Split(vbCr & Join(Filter(sn, "|" & Me("dnum" & j).Caption & vbCr), vbCr & "|" & vbCr), "|"), vbCr, False), "+"))
End If
Next
End Sub
-
Your payday criterion is fuzzy, so I won't be able to create an algorithm.
-
Sorry about the fuzz... :)
My thoughts are to find the first Friday of the year,
which falls in the first week of the year Weeknumber - 1
then every 14 days after that is the Friday day to make Bold if the user picks Every other Friday- regardless of month
-with my research it looks like if the week number is odd (1, 3, 5 etc) would be the Friday we are looking for...
If they choose every Friday: every day 6 of the week gets Bold
If they choose bi-monthly: the 1st and 15th regardless of day of week gets Bold
(optionaly, it would be nice to pick the Friday before a weekend if the 1st or 15th falls on a weekend)
-
It depends on which system you use: I prefer the ISO-weeknumber (because it's an International standard), not the US weeknumber.
every fourth friday in an ISO system
Code:
sn= [date(2015,1,4)-weekday(date(2015,1,4),2)+5+28*(row(1:13)-1)]
-
1 Attachment(s)
Attachment 14399
This has the option buttons and the check boxes working
still ironing out the every other friday, but making progress. :yes
-
I was reading about the ISO version and I'm no sure which to go with.
I suppose to make this more universal for each end users needs, another option could be in order...
It could be a checkbox next to or in the payday options frame..
then based on their choice it fires the correct routine.
Since I (we) have overcome so many region specific date formatting issue, maybe that should be an option too.
A drop down with 3 or 4 date local formatting options, that are a variable used in the functions.
opt1: "m" - d- yyyy
opt2: d - "m"' - yyyy
opt3: yyyy - "m" - d
opt4: yyyy - d - "m"
-
The ISO formattting (the only sensible one) is yyyy mm dd (i.e. small endian).
Please refrain form using 'Call'; it's utterly redundant.
I don't see any need for the checkbox 'Bills'.
I assume the bills should be presented in the 'calendar' anyway: so it's part of M_cal.(no need for a separate routine).
I have no idea what advantage is the use of 'payday' (a concept I am not familiar with and I fear is a local custom somewhere.).
-
You make a great point on the bills being included by default.
I had started with making a calendar to print out for the fridge to know when bills are coming up, and it blossomed (snowballed) into this.
As we accomplished each stage of progress I looked at making each piece modular and so a toggle option made sense.
But as you astutely point out, some parts make no sense to be omitted for a "bill scheduling" calendar.
as far as the 'paydays' (you made me laugh hard - thank you)
I still have a day job (thankfully) and seeing the weekly totals coming up and seeing when the next income helps with planning.
My wife was paid every other Friday - until she quit her job :( mine is bi-monthly - for now,
and I have friends that are every Friday
so I was attempting to make this useful for as many as possible.
I guess it doesn't really matter the date formatting in the background if they are from a label caption or spinner value anyway.
It just needs to accommodate the system default of the user's region I suppose
-
There are a great variety of payday schemes. I have been paid on Thursdays, Fridays, Mondays, Every two weeks, the 1st and 3rd weeks of the month, (interesting when a month has 5 weeks,) the 1st, the last day of the month and now, midnight of the 1st and midnight of the 3rd, except when those dates fell on a non-work day, then it is midnight of the last working day previous, and I know others who receive their monthly stipend on some other particular date, including one who was "paid" quarterly.
For your purposes, I would ignore the Non-Workday situation and let those who have to deal with it just make the mental adjustment when needed.
-
In that case I think it might be wiser to give the opportunity to enter the amount of money in the bank account (I hope you won't be paid cash) at the start of the month. Now the bill calendar can calculate the saldo in the account each day of the month. I think that is more informative than the summing of bills per week.
If you add a means to enter incoming amounts and the days it will be received, you'll have a perfect day-to-day cash flow management tool, even on the fridge.
-
You have a way knack for getting to the best part of an idea.
I hadn't realized that this is really what I'm after all along.
To know how much is available is more helpful then knowing what's about to leave.
So if we add a text box it the top next to the date for Current available funds,
Then subtract all the bills and show the remaining available balance.
Add functionality for debits and deposits to be added at any given day.
This will need more daily updating, but the usefulness has grown exponentially.
I'll rethink the layout, but I'm excited about the opportunity.
We should make a mobile app out of this...
-
I'm still planning a reformat of the userform, but I am driven to figure out Bolding every other Friday.
I think I'm close with this, but it errors on
Code:
If (thisF - F1) Mod 2 = 0 Then
saying type mismatch, runtime error 13
Code:
Sub weeksEoF()
Dim T1, r
Dim thisF, F1 As Date
With ufCal
F1 = ("Jan-1-" & .uYear.Caption)
If Weekday(F1) = 7 Then
'FirstPastFriday = True
'first weekday is a saturday so loook for odd weeks to bold
End If
If .dnum6.Caption <> "" Then
T1 = .dnum6.Caption
Else
T1 = .dnum13.Caption
End If
thisF = .uMonth.Caption & "-" & T1 & "-" & .uYear.Caption
If (thisF - F1) Mod 2 = 0 Then
For r = 6 To 34 Step 7
.Controls("dnum" & r).Font.Bold = True
Next r
Else
For r = 13 To 41 Step 7
.Controls("dnum" & r).Font.Bold = True
Next r
End If
End With
End Sub
-
use:
Code:
If j Mod 14 = 6 Then Me("dnum" & j).Font.Bold = cb_paydays.Value
-
Controls:
- Payday Options Frame
- List boxes w/2+ columns, Column 1, Bound and hidden:
- lbFrequency; C3 = Weekly, SemiWeekly, BiMonthly, Monthly, quarterly,etc; C1 = other listbox names, C2, hidden = Frequency Number
- lbPayday_Day, C2 = Sun to Sat, C1 = 1 to 7
- lb1stPayday_Date, lb2ndPayday. for bimonthly; Might use lbPayday_Day
- lbPayday_Date C1 = 1 to 31, for monthly
Stack the listboxes with lbFrequency on top.
Code:
lbFrequency change
Freq = lbFrequency.Column(1) 'Count from zero
Controls(lbFrequency.Value).ZOrder = fmtop
Assume Weekly or semiweekly, lbPayday_Day on top. Assume Wednesday selected, lbPayday_Day = 4
Code:
pd = LbPayday_Day.Value
if pd => FirstdayofMonth Then .Controls("dnum" & pd).Font.Bold = True
Do While pd < 43
pd = pd + (7 * Freq)
.Controls("dnum" & pd).Font.Bold = True
Loop
-
Thank you samT,
I was trying to implement snb's and thought I was getting closer:
this is not consistent... only worked on January
Code:
Function YearDay(dat As Date) As Integer
YearDay = DateDiff("d", CDate("1/1/" & Year(dat)), dat) + 1
End Function
Sub pdEoF()
' Bolds every other Friday form the second week of the year
Dim x, D As Long
Dim tDay As Date
Dim myDate As Date
With ufCal
For x = 1 To 42
.Controls("dnum" & x).Font.Bold = False
Next x
myDate = .uMonth.Caption & "-1-" & .uYear.Caption
D = FirstWeekDayOfMonth(myDate) - 1
For x = 6 To 41 Step 7
If .Controls("dnum" & x).Caption <> "" Then
tDay = DateValue(Month(.uMonth.Caption) & "-" & Day(.Controls("dnum" & x).Caption) & "-" & Year(.uYear.Caption))
If YearDay(tDay) Mod 14 = 6 Then
.Controls("dnum" & x).Font.Bold = True
End If
End If
Next x
End With
End Sub
I will work on formatting the form to accommodate you ideas too. - keep em coming :)
-
On further consideration, the Payday Options I mentioned before will not work with semi-weekly Frequency. You will need to store the Last Payday Date (in a hidden sheet "VBA_Variables") and refer to it in the emboldening loop
An easy way to refer to the Date of the dnum Controls is to set their Tag Property to the date (1-31)
Code:
PD = VBA_Variables.LastPayday_Date
'See code far below for alternate loop math
Do while Month(DateAdd(ww, 2, PD) = Month(ThisCalendar)
PD = (DateAdd(ww, 2, PD)
For Each Ctrl in .Controls
If Ctrl.Tag = Day(PD) Then 'Assumes that only dnum controls have values 1 to 31
Ctrl.Font.Bold = True
Exit For 'Skip rest of controls during this loop
End If
Next Ctrl
Loop
VBA_Variables.LastPayday_Date = PD
Sometimes when I have to deal with a group controls many times, I will use the following structure. snb also has a neat way of doing this.
Code:
Dim DateCells As Collection
'While setting the Date values of the dnum Captions and Tags
DateCells.Add Ctrl, Ctrl.Tag 'Only add the active dnum controls
Now you can loop thru DateCells Collection to access each used dnum control or you can
Code:
PD = DateAdd(ww, 2,VBA_Variables.LastPayday_Date)
Do while Month( PD) = Month(ThisCalendar)
DateCells(PD).Font.Bold = True
LastPD = PD
PD = DateAdd(ww, 2, PD)
Loop
VBA_Variables.LastPayday_Date = LastPD
-
still designing userform, but
I tweaked this sub into a function to find the second friday of the year,
now I think we can use this as part of the semi-weekly routine.
Code:
Function secondFriday(TDay As Date) As Date
Dim FirstDayOfYear As Date
Dim iWeekDay As Integer
Dim SecondFridayOfYear As Date
Const FridayNumber = 12
TDay = Date
FirstDayOfYear = DateSerial(Year(TDay), 1, 1)
iWeekDay = Weekday(Date:=FirstDayOfYear, FirstDayOfWeek:=vbMonday)
SecondFridayOfYear = DateSerial(Year(FirstDayOfYear), _
1, _
1 + IIf((FridayNumber - iWeekDay) < 0, FridayNumber - iWeekDay + 7, FridayNumber - iWeekDay))
secondFriday = SecondFridayOfYear
End Function
-
Finally got the SemiWeekly working correctly! yeah
Code:
Function FirstWeekDayOfMonth(dDate As Date) As Long
'thanks to SamT thisd lets us know what day of the week the 1st of the month falls on
FirstWeekDayOfMonth = Weekday(Month(dDate) & "-1-" & Year(dDate))
End Function
Function myWeekNum(DT As Date) As Long
DT = Format(DT, "m-d-yyyy")
myWeekNum = Int(((DT - DateSerial(Year(DT), 1, 0)) + 6) / 7)
End Function
Sub pd_EoF()
' Bolds every other Friday form the second week of the year
Dim x, D As Long
Dim TDay As Date
Dim myDate As Date
With ufCal
For x = 1 To 42
.Controls("dnum" & x).Font.Bold = False
Next x
myDate = .uYear.Caption & "-" & .uMonth.Caption & "-1"
D = FirstWeekDayOfMonth(myDate) - 1
For x = 6 To 41 Step 7
If .Controls("dnum" & x).Caption <> "" Then
TDay = DateValue(Year(.uYear.Caption) & "-" & Month(.uMonth.Caption) & "-" & Day(.Controls("dnum" & x).Caption))
If myWeekNum(TDay) Mod 2 = 0 Then
Else
.Controls("dnum" & x).Font.Bold = .ob_EoF.Value
End If
End If
Next x
End With
End Sub
Sub pd_select()
With ufCal
If .Controls("ob_Fridays").Value = True Then
pd_Fridays
ElseIf .Controls("ob_EoF").Value = True Then
pd_EoF
ElseIf .Controls("ob_BiMonth").Value = True Then
pd_BiMonth
ElseIf .Controls("ob_Off").Value = True Then
pd_Off
End If
End With
End Sub
' on the UserForm:
Private Sub ob_BiMonth_Click()
'if the Bi-monthly payday radio button is selected the 1st and 15th day numbers will be Bold
pd_BiMonth
End Sub
Private Sub ob_EoF_Click()
pd_EoF
End Sub
Private Sub ob_Fridays_Click()
pd_Fridays
End Sub
Private Sub ob_Off_Click()
pd_Off
End Sub
Private Sub sMonth_Change()
'when the up or down arrow is clicked change the Month and update the calendar day numbers and bill dates
uMonth.Caption = sMonth
m_Cal
pd_select
End Sub
Private Sub sYear_Change()
'when the year up or down arrows are clicked update the calendar days and bill days
uYear.Caption = sYear
m_Cal
pd_select
End Sub
