build userform calendar using "cell counting" method looping named labels (SamT)

How would I adapt this cell counting method to work on a userform where I have named the day number labels as dnum1, dnum2 etc... to dnum42 it's a 6 x 7 calendar

Code:

---

Option Explicit

Private CalendarTable As Range
Private FirstCalendarCell As Long

Function DaysInMonth(dDate As Date) As Long
DaysInMonth = Day(EOM(dDate))
End Function

Function EOM(dDate As Date) As Date
    dDate = Format(dDate, "d-m-yyyy") 'Adjust as needed per your System and Locale
    EOM = DateAdd("d", -1, DateValue(Month(dDate) + 1 & "-1-" & Year(dDate)))
End Function

Function FirstWeekDayOfMonth(dDate As Date) As Long
FirstWeekDayOfMonth = Weekday(Month(dDate) & "-1-" & Year(dDate))
End Function

Sub Initialize_CalendarTable()
Const SinglesPrefix As String = "                  " 'One space less than cell with
Const DoublesPrefix As String = "                  " 'two spaces less than cell with

Dim c As Long
Dim D As Long

Set CalendarTable = Range("B3:H8")                            ' myCal_label_array? ufCal.dnum1 to ufCal.dnum42
FirstCalendarCell = FirstWeekDayOfMonth(Range("B1"))  ' myDate = ufCal.uMonth.Caption & "-" & ufCal.uYear.Caption
Application.EnableEvents = False

D = FirstCalendarCell - 1
With CalendarTable                                ' myCal_label_array? - userform name is ufCal
  .Cells.ClearContents                              ' loop all ufCal.dnum1 - ufCal.dnum42 and clear caption
  For c = 1 To DaysInMonth(Range("B1")) ' myDate
  .Cells(D + c).Value = c & vbLf                ' dnum & D + c & .caption = c...  or dnum(D +c).caption...
  Next c
End With

Application.EnableEvents = True
End Sub

---

Code:

---

Sub Initialize_CalendarTable()
  'Also see Sub UserForm_Initialize()
   
    'Const SinglesPrefix not needed with UserForm
    'Const DoublesPrefix  not needed
    '
    'in Design mode Set Day Labels TextAlign Property = Right
    'Hint: hold Ctrl key down to select all labels, then set the property for all at once
   
    Dim c As Long
    Dim D As Long
    Dim MyDate As Date

    MyDate = CDate("1-" & ufCal.uMonth.Caption & "-" & ufCal.uYear.Caption)
    'D = zero reference of Days of month
    D = FirstWeekDayOfMonth(MyDate) - 1
       
        'clear captions 'Hint: Set Captions to "" In design mode instead.
        For c = 1 To 42
            Me.Controls("dnum" & c).Caption = ""
        Next c

        'Set Captions
        For c = 1 To DaysInMonth(MyDate) ' myDate
            Me.Controls("dnum" & D + c).Caption = c
        Next c
   
End Sub

---

Code:

---

Sub UserForm_Initialize()
'Assumes Design Mode changes made as above
   
    Dim c As Long
    Dim D As Long
    Dim MyDate As Date

    MyDate = CDate("1-" & ufCal.uMonth.Caption & "-" & ufCal.uYear.Caption)
    'D = zero reference of Days of month
    D = FirstWeekDayOfMonth(MyDate) - 1

        'Set Captions
        For c = 1 To DaysInMonth(MyDate)
            Me.Controls("dnum" & D + c).Caption = c
        Next c
End Sub

---

Stroke of genious!
Me.Controls("dnum" & c).Caption = "" was the part I was missing! thank you.

One thing I noticed though,
When I alter the uMonth date and run the intialize_calendar, the first day of month doesnt change?

Here is my file if you want to see the form I'm working with.
I copied much of the code from the worksheet version you helped me with, so sorry for the duplication..
Attachment 14363

I found it, I'm in USA where we use m-d-yyyy

Code:

---

Sub fill_ufCal_dnum()
    'Also see Sub UserForm_Initialize()
    Dim c As Long
    Dim D As Long
    Dim MyDate As Date
   
    MyDate = CDate(ufCal.uMonth.Caption & "-1-" & ufCal.uYear.Caption) ' was - MyDate = CDate("1-" & ufCal.uMonth.Caption & "-" & ufCal.uYear.Caption)
    'D = zero reference of Days of month
    D = FirstWeekDayOfMonth(MyDate) - 1
   
    'clear captions 'Hint: Set Captions to "" In design mode instead.
    For c = 1 To 42
        Me.Controls("dnum" & c).Caption = ""
    Next c
   
    'Set Captions
    For c = 1 To DaysInMonth(MyDate) ' myDate
        Me.Controls("dnum" & D + c).Caption = c
    Next c
   
End Sub

---

Thank you SamT
You are phenomenal!

I was premature in my victory ;(
I got the start day working but December is still acting as the month and day are reversed - or wrong.

Code:

---

Option Explicit

Private CalendarTable As Range
Private FirstCalendarCell As Long

Function DaysInMonth(dDate As Date) As Long
    dDate = Format(dDate, "m-d-yyyy")
    DaysInMonth = Day(EOM(dDate))
End Function

Function EOM(dDate As Date) As Date
    dDate = Format(dDate, "m-d-yyyy") 'Adjust as needed per your System and Locale
    EOM = DateAdd("d", -1, DateValue(Month(dDate) + 1 & "-1-" & Year(dDate))) ' this part I'm not sure if I have it correct?
End Function

Function FirstWeekDayOfMonth(dDate As Date) As Long
    dDate = Format(dDate, "m-d-yyyy")
    FirstWeekDayOfMonth = Weekday(Month(dDate) & "-1-" & Year(dDate))
End Function

Sub UserForm_Initialize()
    Dim lbtarget As MSForms.ListBox
    Dim rngSource As Range
    Dim lrB As Integer
    Dim wsB As Worksheet
    Dim c As Long
    Dim D As Long
    Dim MyDate As Date
   
    MyDate = Format(MyDate, "m-d-yyyy")
   
    Set wsB = Sheets("Bills")
    lrB = wsB.Cells(Rows.Count, 2).End(xlUp).Row
    Set rngSource = wsB.Range("B2:D" & lrB)
   
    Me.uMonth.Caption = wsB.Range("cMonth").Value
    Me.sMonth.Value = wsB.Range("cMonth").Value
   
    Me.uYear.Caption = wsB.Range("cYear").Value
    Me.sYear.Value = wsB.Range("cYear").Value
   
    Set lbtarget = ufCal.lbBills
    With lbtarget
        .ColumnCount = 3
        .ColumnWidths = "72;42;32"
        .List = rngSource.Cells.Value
    End With
   
    MyDate = CDate(ufCal.uMonth.Caption & "-1-" & ufCal.uYear.Caption)
   
    D = FirstWeekDayOfMonth(MyDate) - 1
   
    For c = 1 To DaysInMonth(MyDate)
        ufCal.Controls("dnum" & D + c).Caption = c
    Next c
   
End Sub

Sub fill_ufCal_dnum()
    'Also see Sub UserForm_Initialize()
    Dim c As Long
    Dim D As Long
    Dim MyDate As Date
   
    MyDate = Format(MyDate, "m-d-yyyy")
   
    MyDate = CDate(ufCal.uMonth.Caption & "-1-" & ufCal.uYear.Caption)
    'D = zero reference of Days of month
    D = FirstWeekDayOfMonth(MyDate) - 1
   
    'clear captions 'Hint: Set Captions to "" In design mode instead.
    For c = 1 To 42
        ufCal.Controls("dnum" & c).Caption = ""
    Next c
   
    'Set Captions
    For c = 1 To DaysInMonth(MyDate) ' myDate
        ufCal.Controls("dnum" & D + c).Caption = c
    Next c
   
End Sub

---

Try this format
"d-mmm-yy"

that made it worse.
The calendar only shows the first day.
I changed to m-d-yyyy to get the calendar to populate all but december (stops on the 12th again)

Mark,

I actually looked at your code this time and I notice that in subs UserForm_Initialize and fill_ufCal_dnum you are setting the format of myDate way at the top. That is no good, because when you actually assign a value later in the sub, it takes on the format in which you assign the value.

That should not matter because I wrote those three Functions to handle any date input to them in any format.

Anyway, try this new EndOf Month function

Code:

---

Function EOM(dDate As Date) As Date
    dDate = DateAdd("m", 1, dDate)
    EOM = DateAdd("d", -1, DateValue(Month(dDate) & "-1-" & Year(dDate)))
End Function

---

I brainfarted that Month(Date) + 1 does not return a valid number (1) when month = 12

I'd reduce the Initialize code to:

Code:

---

Sub UserForm_Initialize()
    With Sheets("Bills")
        lbBills.List = .Cells(1).CurrentRegion.Offset(1, 1).SpecialCells(2).Value
 
        sMonth.Value = Sheets("Bills").Range("cMonth").Value
        sYear.Value = Sheets("Bills").Range("cYear").Value
    End With
   
    For j = 1 To Day(DateAdd("m", 1, DateSerial(sYear, sMonth, 1)) - 1)
        Me("dnum" & Weekday(DateSerial(sYear, sMonth, 1)) + j - 1).Caption = j
    Next
End Sub

---

In design mode you can put the lbBills property columncount to 3 and columnwidth to 72;42;30

@ snb,

Nice code.

Why didn't you assign the zero day value to a variable outside the loop? Wouldn't it be faster?



@ Mark,

Your UserForm Calendar would be a nice addition to the KB after you get it working, perfected, and cleaned up. Why don't you submit it to the Potential KB Entries Folder when it's working and we will help you perfect and generalize it.

I rewrote the userform code.

Thank you snb and SamT, yet again.

snb: The dates for december are working correctly, awesome. I noticed the user form code does some sorting on the sheet when i click the lbList Labels that I think triggers a sheet change event I use to make the line numbers and coloring to update as user adds or removes lines, causing several sorts to take place. I will focus on getting the sorting straightened out then we can look at streamlining everything and cleaning up the interface. My doe added zeros to sort the due date, but it keeps adding an extra zero each time you press it. need to find a way to eliminate the extra zero after the sort. I will try to incorporate your method.
I like the look of making a single sort function that we can pass the list index too, cool.

SamT: That EOM code did the trick.
I have the code working to insert the bills into the calendar now too.
And the payday hi lights ( 1st and 15th ) now is working - I am considering adding 3 options for paydays - every friday, every other friday or 1 and 15th. maybe check box. Currently I'm fixing the weekly sum feature, this will be a challenge (as if all before this was a cake walk, lol - thank you for the help)

I would love to have this project submitted for the KB, I would add the sheet based version I made too as an option, there is a lot of neat and efficient coding we used there. I started this project using formulas without vb so it could work on a microsoft surface RT tablet. We could add that as well.
I'll update with my next stage of progress - thanks to you both.
-mark

Attachment 14377
This has snb's code for initializing and SamT's for EOM calculating plus mine to insert bills on the user form.
Still working on the weekly sums, and choosing options to let user select what days to highlight for paydays. weekly. eow, bi-monthly.
Next step will be formatting to print.
Thank you again for your help.:bow:

A new version

Thank you snb!
The sorting is awesome.
I hadn't noticed why you removed the Mod button from the userform until I was commenting all the subs and noticed what you did.
When we select an item in the bill list its values are available in the entry box above. changing those values updates the list values, nicely done!

I added the routine to sum the bills by week.

Code:

---

Sub addSums_UF()
Dim Result, BillsTotal As Double
Dim Bills As Variant
Dim Bill As String
Dim b, x As Long
Dim P1, NumberFromBill
   
With ufCal
    If .cb_sums.Value = True Then
            z = 1
            For y = 0 To 35 Step 7
            Result = 0
                For x = 1 To 7
                    For b = 0 To .Controls("dcell" & x + y).ListCount - 1
                        Bill = .Controls("dcell" & x + y).List(b)
                        P1 = InStr(1, Bill, "-")
                        NumberFromBill = Trim(Right(Bill, Len(Bill) - P1))
                        Result = Result + NumberFromBill
                    Next b
                Next x
                .Controls("sum" & z).Caption = Result
                z = z + 1
            Next y
       
    Else
        For z = 1 To 6
            .Controls("sum" & z).Caption = ""
        Next z
    End If
   
End With

End Sub

---

I am still having issues with the bills values in the lbList being added or removed from the dcell after the lbList has been altered after initialization.

If I add, remove or modify the values in the lbList then add the bills to the dcells the list is representative of the intialized values, not the current values.
How do I take the current values in the lbBills list to fill the dcells? - not the initialized values

Attachment 14386
Here is the current file with each routine commented with explanation.
Altering the lbBill list and then using that list to copy from listbox (lbBills) to listbox(dcell1 to 42) results in the intialized values being copied, not current values if they have been modified.

Strange, when I click due to sort by due day, then remove and add bills to dcell1-dcell42 the correct info gets applied?!

Also snb:
I'm not sure where to modify your M-Cal code to put a "-" in between the bill name and b ill amount.
My code for summing looks for the "-" to know where the numbers begin...

Code:

---


Sub M_cal()
'thanks to snb this sets the day captions and fills the day listboxes with the bills for that day
    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
        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 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)), "~") ' i'm guessing its somewhere in here
    Next
End Sub

---

to sum the bills per week a oneliner suffices:

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 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

---

other questions answered in the attachment

you make it look so simple - oneliner king

Here I'm mostly done with the payday radio button,
working on calculating odd even weeknumbers to know which friday is everyother friday.Attachment 14391

Code:

---

Function WeekNum(DT As Date) As Long
    WeekNum = Int(((DT - DateSerial(Year(DT), 1, 0)) + 6) / 7)
End Function

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

---

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)]

---

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

---