PDA

View Full Version : [SOLVED] Code for a Calendar W/Notes



mperrah
08-19-2015, 08:28 AM
I have a userform (CalendarOpts) that gets a 3 column listbox (lbBills)
populated from a range on my main sheet B2 to D & lastrow

On the userform I allow the user to add, remove and modify the listbox items.

Then we can generate a calendar that gets populated with the listbox values.

My problem is even if the values have been modified, the calendar seems to get the original initialized values, not the modified list.
Is there a way to register in memory (or what ever is necessary) the new values from the userform

This is the initialize code:

Private Sub UserForm_Initialize()
Dim lbtarget As MSForms.ListBox
Dim rngSource As Range
Dim lrB As Integer
Dim wsB As Worksheet

Set wsB = Sheets("Bills")
lrB = wsB.Cells(Rows.Count, 2).End(xlUp).Row
Set rngSource = wsB.Range("B2:D" & lrB)

Me.lblMonth.Caption = wsB.Range("cMonth").Value
Me.sbMonth.Value = wsB.Range("cMonth").Value

Me.lblYear.Caption = wsB.Range("cYear").Value
Me.sbYear.Value = wsB.Range("cYear").Value

Set lbtarget = Me.lbBills
With lbtarget
.ColumnCount = 3
.ColumnWidths = "90;60;20"
.List = rngSource.Cells.Value
End With

End Sub



This is the makecalendar code:

Sub makeCalendar()
Dim t, lrV, x As Long
Dim StartDay, DayofWeek, CurYear, CurMonth, FinalDay As Date
Dim wsB, ws As Worksheet
Dim MyInput As String
Dim dNum As Range

Set wsB = Sheets("Bills")

With wsB
If IsUserFormLoaded(CalendarOpts.Name) = True Then
MyInput = CalendarOpts.sbMonth.Value & "-" & CalendarOpts.sbYear.Value
Else
MyInput = .Range("cMonth").Value & "-" & .Range("cYear").Value
End If

If MyInput = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
If ws.Name = MyInput Then
ws.Activate
MsgBox ("The Calendar Month you are trying to create already exists." & vbCrLf & " The Options menu will close now.")
End
End If
Next ws

lrV = .Cells(Rows.Count, 2).End(xlUp).Row

End With

Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyInput

ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False

StartDay = DateValue(MyInput)

If Day(StartDay) <> 1 Then
StartDay = DateValue(Month(StartDay) & "/1/" & Year(StartDay))
End If

Range("a1").NumberFormat = "mmmm yyyy"

With Range("a1:h1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Size = 18
.Font.Bold = True
.RowHeight = 35
End With

With Range("a2:h2")
.ColumnWidth = 20
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.Font.Size = 10
.Font.Bold = True
.RowHeight = 16
End With

Range("a2") = "Sunday"
Range("b2") = "Monday"
Range("c2") = "Tuesday"
Range("d2") = "Wednesday"
Range("e2") = "Thursday"
Range("f2") = "Friday"
Range("g2") = "Saturday"
Range("h2") = "Week Subtotal"

With Range("a3:h8")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.Font.Size = 12
.Font.Bold = True
.RowHeight = 14
.ColumnWidth = 18
End With

Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")

DayofWeek = Weekday(StartDay)

CurYear = Year(StartDay)
CurMonth = Month(StartDay)

FinalDay = DateSerial(CurYear, CurMonth + 1, 1)

Select Case DayofWeek
Case 1
Range("a3").Value = 1
Case 2
Range("b3").Value = 1
Case 3
Range("c3").Value = 1
Case 4
Range("d3").Value = 1
Case 5
Range("e3").Value = 1
Case 6
Range("f3").Value = 1
Case 7
Range("g3").Value = 1
End Select

For Each dNum In Range("a3:g8")

If dNum.Column = 1 And dNum.Row = 3 Then

ElseIf dNum.Column <> 1 Then
If dNum.Offset(0, -1).Value >= 1 Then
dNum.Value = dNum.Offset(0, -1).Value + 1

If dNum.Value > (FinalDay - StartDay) Then
dNum.Value = ""
Exit For
End If
End If

ElseIf dNum.Row > 3 And dNum.Column = 1 Then
dNum.Value = dNum.Offset(-1, 6).Value + 1

If dNum.Value > (FinalDay - StartDay) Then
dNum.Value = ""
Exit For
End If
End If
Next

For x = 0 To 5
Range("A4").Offset(x * 2, 0).EntireRow.Insert
With Range("A4:H4").Offset(x * 2, 0)
.RowHeight = 85
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Font.Size = 10
.Font.Bold = False
.Locked = False
End With

With Range("A3").Offset(x * 2, 0).Resize(2, 8)
.Borders(xlLeft).Weight = xlThin
.Borders(xlLeft).ColorIndex = xlAutomatic
.Borders(xlRight).Weight = xlThin
.Borders(xlRight).ColorIndex = xlAutomatic
.BorderAround Weight:=xlThin, ColorIndex:=xlAutomatic
End With
Next x

ActiveWindow.DisplayGridlines = False

End Sub

and this is the cod eto insert the bills:

Sub insertBills_UF()
Dim a, b, r, c, x, i, j As Long
Dim lbCnt As Integer
Dim ws, wsB, wsSel As Worksheet
Dim aBills()
Dim mySheet As String

mySheet = CalendarOpts.lblMonth.Caption & "-" & CalendarOpts.lblYear.Caption
If mySheet = "" Then
MsgBox ("A calendar has not yet been made with the current Month Selection")
Exit Sub
End If

For Each ws In ThisWorkbook.Worksheets
If ws.Name = mySheet Then
ws.Activate
Set wsSel = ws
End If
Next ws

If SheetExist(mySheet) Then

Else
MsgBox ("The Sheet Does NOT Exists")
Exit Sub
End If

lbCnt = CalendarOpts.lbBills.ListCount - 1

ReDim aBills(0 To lbCnt, 0 To 2)

For a = 0 To lbCnt
aBills(a, 0) = CalendarOpts.lbBills.List(a, 0)
aBills(a, 1) = CalendarOpts.lbBills.List(a, 1)
aBills(a, 2) = CalendarOpts.lbBills.List(a, 2)
Next a

With wsSel
For b = 0 To lbCnt
For r = 3 To 38 Step 6
For c = 1 To 7
If .Cells(r, c).Value <> "" Then
If .Cells(r, c).Value = aBills(b, 2) Then
For x = 1 To 5
If .Cells(r + x, c).Value = "" Then
.Cells(r + x, c).Value = aBills(b, 0) & "-" & aBills(b, 1)
Exit For
End If
Next x
End If
End If
Next c
Next r
Next b
End With

End Sub

I have tried adding the modifications to the sheet then re-initialize from the sheet data,
this kind of works. but if there is a way to pull from the modified listbox would be more efficient,
eliminating going back and forth from the sheet and userform.

p45cal
08-19-2015, 03:22 PM
A workbook please with a minimum of non-sensitive data, a userform etc. to prevent us having to try (wrongly) to re-create your workbook.
As an aside: "On the userform I allow the user to add, remove and modify the listbox items" -how?

SamT
08-19-2015, 04:45 PM
I'm looking at that really deep FOR and IF loop in sub Sub insertBills_UF.

The Cells of a range, such as a 7x6 Calendar table, are numbered from top left to the right, then down. So Range("calendar").Cells(3) would be the Tuesday in the First week row. The Code

X =WeekDay("Aug-1-2015")
will return the number of the weekday of that date. In this particular case X = 7: The first Day of Aug was a Saturday, the 7th Cell of a Calendar Table

Since Day(Date) returns the day of the month of the given date, The code

Range("Calendar").Cells((X - 1) + Day(Date))
Will always return the correct Cell in the Calendar for that Date.

Today is Aug 19, so the calendar space for today is (7-1) + 19 or Cell # 25 of the Calendar. 7*3 = 21. 25 - 21 = 4. Today is the 4th day of the 4th week row. Wednesday.

If Sunday is not the first day of your weeks, be sure to see the helps for Day and Weekday to see how to compensate for a non default first day of week.

pr: The full name of the X variable above is "intFirstWeekdayOfMonth"

mperrah
08-21-2015, 12:50 PM
14226 here you go p45Cal.
I have 3 textboxes, their values can be inserted in to the listbox.list with a command button "Add".
they can select an item in the listbox list and click command button "Modify", and the selected list item is overwritten with contents of text boxes.
they can select a list item and click command button "Remove", and the selected item is deleted from the listbox.
as they click a list item, its values get entered in the text boxes to make editing easier.
the command button "Clear" empties the textboxes to make a new entry.

SamT, I wasn't sure the best way to loop through all the calendar days then loop through 5 available slots for a bill to be inserted.
This, while clumsy, seems to work. I'll try to implement your solution.
I found the calendar generator on a forum so not sure all the ins and outs of its coding, but it seems to function for my purposes.

My current issue is I have set the calendar to hold a max of 5 bills per a given day.
I want to test if a bill being added in the listbox exceeds 5 bills on a given day,
the goal is select the day textbox and let them alter the day then finish the script.
Also n the Sheet, do the same thing. (I kind of have this part working)
if they add a new bill with a day that has 5 already, prompt the user to change it.

I have a sub that fires when they add a bill on the userform, but it doesnt seem to count correctly.

if I load the userform with 5 matching day bills and add one
it doesnt display the msgbox till I add a second matching bill instead of the first 1 causing the error message?!

here is the code that tests the 5 count

Sub test_5in1_UF()
' when adding new bill or making calendar from UF test for 5 bills per day
Dim i As Long, maxCount As Long, maxDup As Long
Dim myArray() As Long

ReDim myArray(1 To 31)
With CalendarOpts.lbBills
For i = 0 To .ListCount - 1
myArray(Val(.List(i, 2))) = myArray(Val(.List(i, 2))) + 1
If maxCount < myArray(Val(.List(i, 2))) Then
maxCount = myArray(Val(.List(i, 2)))
maxDup = Val(.List(i, 2))
End If
Next i
End With

If maxCount > 5 Then
MsgBox "There are " & maxCount & " bills for the " & maxDup & ". Only 5 bils will appear on the Calendar."
End If

End Sub

this is part that I tested adding the list back to the sheet where my test works then re-loading the userform...

Private Sub cbAddtoSheet_Click()
Dim i, j, lrB As Long
Dim arrItems()
Dim wsB As Worksheet

Application.ScreenUpdating = False

Set wsB = Sheets("Bills")
lrB = wsB.Cells(Rows.Count, 2).End(xlUp).Row

wsB.Range("B2:D" & lrB).ClearContents

ReDim arrItems(0 To lbBills.ColumnCount - 1)
For j = 0 To lbBills.ListCount - 1

For i = 0 To lbBills.ColumnCount - 1
arrItems(i) = lbBills.Column(i, j)
Next i

wsB.Cells(j + 2, "B").Resize(, lbBills.ColumnCount).Value = arrItems

Next j

Call UserForm_Initialize

Application.ScreenUpdating = True

End Sub

thank you for your interest

SamT
08-21-2015, 03:48 PM
Instead of use Calendar days with 5 cells each, use a single cell and the Cell Counting method above, but when adding Bills


If Cell.Value = "" Then
Cell.Value = "Bill String"
Else
Cell.Value = Cell.Value & vbLF & "Bill String"
End If
there is no effective1 limit on how many lines (bills) a cell can hold.

1: the limit is 32K characters including the vbLF character

mperrah
08-21-2015, 04:23 PM
Thank you, I actually had thought of that. The only snag is I have a sum of the amounts due per week at the right of each week.
In each cell (so far up to 5) for each day I have the bill name then a dash then the amount due (name - amount)
I use a formula to pull just the numbers from the right of the bill in each of the 5 rows per day and sum them in the day number row.

14227
I can figure how to do the calculations on the "Bills" sheet before making the calendar from the Sheet macro,
But I am at a loss how to due this in the userform macro.
I suppose if i do the calculations on the sheet then add them in a hidden column of the listbox...
But adding, removing or editing the listbox becomes an issue for these pre-made calculations...
and that is why I started this post.
I run into trouble with values in list box that have been altered after initialization.
If I am not limited to 5 entries per day, some of the testing could be eliminated.. nice
I'll have to ponder this. Thank you SamT

p45cal
08-21-2015, 05:25 PM
I have a sub that fires when they add a bill on the userform, but it doesnt seem to count correctly.

if I load the userform with 5 matching day bills and add one
it doesnt display the msgbox till I add a second matching bill instead of the first 1 causing the error message?!
The code behind the Add button calls test_5in1_UF before adding to the .List (that's not fine) and regardless of the warning it adds it anyway (that's fine).

I haven't looked in depth at the rest of the code, but if you could try calling the test after addition to the .List instead of before and then update us on what's next going wrong.

By the way, while stepping through the code, you need to add some application.enableevents=true/false as there's a lot of unnecessary worksheet_change events being handled.

SamT
08-21-2015, 06:06 PM
How about: Adding a hidden blank column between the calendar table and the weekly totals column so you can use Cell counting

Use a UDF in the weekly totals column

Public Function BillsTotal(WeeksCells As Range) As Double
Dim Result As Double
Dim Bills As Variant
Dim Bill As String
Dim Cel As Range
For Each Cel In WeeksCells
Bills = Split(Cel.Value, vbLf)
For i = LBound(Bills) To UBound(Bills)
Bill = Bills(i)
'Code Extract Number From Bill goes here
Result = Result + NumberFromBill
Next i
Next Cel
BillsTotal = Result
End Function
The Formula in I3 = "=BillsTotal(A3:G3)" (With a Blank Column G)

SamT
08-21-2015, 06:34 PM
if you intend to use a UserForm to display and edit the calendar, then use a database table to record all information.

Each named Range(Calendar Cells 1 to 42) is 3 columns. You can use Range(Name).Columns(1 and 2) to reference Bills and Amounts and Range(Name).Cells(3 and 6) to reference Dates and Totals. You can also use Range(Name).Range("C1") to reference the date and ("C2") for the Total.

In this example, the first day of the month falls on a Monday. Note that even if you fill all CalendarCell Controls with the values in42 of these Named Ranges, the CalendarCell1 Controls and all other after the last day of the month, will be as empty as the cells in this table.



CalendarCell1

CalendarCell2
CalendarCell3





Bill
Amount

1


Bill
Amount

2







Bill
Amount
SubTotal
Bill
Amount
SubTotal





Bill
Amount

Bill
Amount






Bill
Amount

Bill
Amount






Bill
Amount

Bill
Amount






Bill
Amount

Bill
Amount



























































For Aug, 2015, Range("CalendarCell7").Cells(3).Value = 1

mperrah
08-22-2015, 02:40 PM
My sub builds the calendar and adds the bills in sequence. I wasn't intending to adjust the calendar once it's made, per se. I was thinking if I add a bill it would be for the next month and as I build the calendar it fets added to the new one. I like the multiple lines in each cell and will attempt to incorporate that method.
I considered doing a scan in the bill list for the max number of bills on a day then using that as a variable to build the calendar. 1 row to what ever the max is)
using one cell could simplify the build process. I need to test the sub totaling and rebuild around that. Gonna have some homework. I love it. Thank you again samT

SamT
08-22-2015, 03:28 PM
:beerchug:

mperrah
08-23-2015, 10:24 AM
P45cal,
i run the test before adding because if there are already 5 items with same date I want to prompt the user to change the date of what they are adding. Maybe there is a better way of going about this.
On the sheet I had a worksheet_change event that catches this. But I could not get it to work as intended on the user form. When I add or modify the listbox the count of matching dates seems to count incorrectly. Like it looks at the initial count in the list rather then the modified count.

p45cal
08-23-2015, 03:18 PM
P45cal,
i run the test before adding because if there are already 5 items with same date I want to prompt the user to change the date of what they are adding. Maybe there is a better way of going about this.
But they don't get that opportunity, it goes on and adds them anyway.





But I could not get it to work as intended on the user form. When I add or modify the listbox the count of matching dates seems to count incorrectly. Like it looks at the initial count in the list rather then the modified count.Correct! Because as I said, it counts the items in the list before adding anything (it also looks for >5, not >4 or exactly 5). I suggested in my previous post moving the test after adding to the list. Did it work any better - or didn't you test?

mperrah
08-23-2015, 08:36 PM
p45cal - not tested yet. I have 1 pc at home with excel and my daughter usually confiscates it. I am installing it on a second one tonight, so I will update.. Thank you.

SamT - regarding the post #3
where does the 3 come from in 7*3 ?


Today is Aug 19, so the calendar space for today is (7-1) + 19 or Cell # 25 of the Calendar. 7*3 = 21. 25 - 21 = 4. Today is the 4th day of the 4th week row. Wednesday.

mperrah
08-23-2015, 08:50 PM
p45cal - The sub seems to show the correct counting after using your suggestion to move the test after the add. Thank you.
Now what is a good way to prompt the user to change the 6 occurrence?
Ideally I'd like to select or highlight the 6 occurrence, or have a input box or userform with the date selected for changing.
Then after the user inputs a new date, it gets added or modified in the listbox. Thank you again.

SamT
08-24-2015, 07:12 AM
SamT - regarding the post #3
where does the 3 come from in 7*3 ?

Today is Aug 19, so the calendar space for today is (7-1) + 19 or Cell # 25 of the Calendar. 7*3 = 21. 25 - 21 = 4. Today is the 4th day of the 4th week row. Wednesday.
Calendar Cell 25 is in the 4th Week Row. The last Calendar Cell of the 3rd Week Row is Cell 3x7

mperrah
08-24-2015, 09:29 AM
SamT: not having success implementing your cell counting proposal.
Would you spell it out or save a workbook with it working please, i'd like to try it.

Also the Post #8 with the function for summing.
My code to strip the amounts from the name-amount format is quite lengthy,
not sure how the best way to incorporate the 2.

I plopped a formula on the sheet that does the calculating.
Maybe there is a way to accomplish this in vba, or as part of a function?


Sub sumWeekly_WS()
Dim r, x As Long
Dim ws, wsB, wsSel As Worksheet
Dim mySheet As String

Set wsB = Sheets("Bills")

mySheet = wsB.Range("cMonth") & "-" & wsB.Range("cYear")
If mySheet = "" Then
MsgBox ("A calendar has not yet been made with the current Month Selection")
Exit Sub
End If

For Each ws In ThisWorkbook.Worksheets
If ws.Name = mySheet Then
ws.Activate
Set wsSel = ws
End If
Next ws

If SheetExist(mySheet) Then

Else
MsgBox ("The Sheet Does NOT Exists")
Exit Sub
End If

With wsSel
.Cells(2, 8).Value = "Week Subtotal"
For r = 3 To 33 Step 6
.Cells(r, 8).FormulaR1C1 = "=Sum(R[1]C:R[5]C)"
For x = 1 To 5
.Cells(r + x, 8).FormulaR1C1 = "=SUM(IFERROR(TRIM(RIGHT(RC1,LEN(RC1)-(FIND(""-"",RC1)))),0),IFERROR(TRIM(RIGHT(RC2,LEN(RC2)-(FIND(""-"",RC2)))),0),IFERROR(TRIM(RIGHT(RC3,LEN(RC3)-(FIND(""-"",RC3)))),0),IFERROR(TRIM(RIGHT(RC4,LEN(RC4)-(FIND(""-"",RC4)))),0),IFERROR(TRIM(RIGHT(RC5,LEN(RC5)-(FIND(""-"",RC5)))),0),IFERROR(TRIM(RIGHT(RC6,LEN(RC6)-(FIND(""-"",RC6)))),0),IFERROR(TRIM(RIGHT(RC7,LEN(RC7)-(FIND(""-"",RC7)))),0))"
Next x
Next r

.Columns("H:H").HorizontalAlignment = xlCenter
.Range("H34:H38,H28:H32,H22:H26,H16:H20,H10:H14,H4:H8").Font.Color = vbWhite

If .Range("A33").Value = "" Then .Range("A33").Offset(0, 0).Resize(6, 8).EntireRow.Delete

If .Range("A27").Value = "" Then .Range("A27").Offset(0, 0).Resize(6, 8).EntireRow.Delete

End With

End Sub

mperrah
08-24-2015, 09:45 AM
Also, not familiar with database tables re: post #9
how would I set that up and utilize it?
Are you suggesting making a single sheet with 1 calendar to load instead of a new sheet for each month? or is the database invisible like an array?
and how many rows do I use for each week? 1 for the day number and 1 for the bills? or do the rows expand based on number of bills?
Sorry so many questions, your ideas are exciting and I would like to get them working for my project.

mperrah
08-24-2015, 02:55 PM
Trying this application of SamT's code.
This errors on "Find" not defind.
In my sheet formula it finds the "-" in the string and pulls the number from whats to the right. (post #17) is the whole code.
Not sure how to manipulate this?


Public Function BillsTotal(WeeksCells As Range) As Double
' I3 = "=BillsTotal(A3:G3)"
Dim Result As Double
Dim Bills As Variant
Dim Bill As String
Dim Cel As Range
For Each Cel In WeeksCells
Bills = Split(Cel.Value, vbLf)
For i = LBound(Bills) To UBound(Bills)
Bill = Bills(i)
NumberFromBill = Trim(Right(Bill, Len(Bill) - (Find("" - "", Bill))))
Result = Result + NumberFromBill
Next i
Next Cel
BillsTotal = Result
End Function

mperrah
08-24-2015, 03:38 PM
Yessss, got it to work. !

Public Function BillsTotal(WeeksCells As Range) As Double
' I4 = "=BillsTotal(A4:G4)"
Dim Result As Double
Dim Bills As Variant
Dim Bill As String
Dim Cel As Range
Dim NumberFromBill As Double
Dim P1 As Integer
For Each Cel In WeeksCells
Bills = Split(Cel.Value, vbLf)
For i = LBound(Bills) To UBound(Bills)
Bill = Bills(i)

P1 = InStr(1, Bill, "-")
NumberFromBill = Trim(Right(Bill, Len(Bill) - P1))

Result = Result + NumberFromBill
Next i
Next Cel
BillsTotal = Result
End Function

p45cal
08-24-2015, 04:18 PM
p45cal - The sub seems to show the correct counting after using your suggestion to move the test after the add. Thank you.
Now what is a good way to prompt the user to change the 6 occurrence?
Ideally I'd like to select or highlight the 6 occurrence, or have a input box or userform with the date selected for changing.
Then after the user inputs a new date, it gets added or modified in the listbox. Thank you again.Something along the lines of:
Private Sub cbAddNew_Click()
Dim lc As Integer
Call add_test_28_31_UF
'Call test_5in1_UF
If Application.CountIf(Sheets("Bills").Range(Cells(2, "D"), Cells(Rows.Count, "D").End(xlUp)), tbNewBillDueDay.Value) >= 5 Then
theDate = DateSerial(Val(lblYear), Val(lblMonth), Val(tbNewBillDueDay.Value))
MsgBox "Stop, too many bills on the " & Format(theDate, "mmm d yyyy") & vbLf & "Choose another date"
Else
With Me
lc = .lbBills.ListCount
.lbBills.AddItem
.lbBills.List(lc, 0) = .tbNewBillName.Value
.lbBills.List(lc, 1) = .tbNewBillAmount.Value
.lbBills.List(lc, 2) = .tbNewBillDueDay.Value
End With
Call cbAddtoSheet_Click
End If
End Sub

SamT
08-24-2015, 07:56 PM
Here ya go

SamT
08-24-2015, 09:01 PM
Also, not familiar with database tables re: post #9


how would I set that up and utilize it?
Are you suggesting making a single sheet with 1 calendar to load instead of a new sheet for each month? or is the database invisible like an array?
and how many rows do I use for each week? 1 for the day number and 1 for the bills? or do the rows expand based on number of bills?

Sorry so many questions, your ideas are exciting and I would like to get them working for my project.

1: Each TableCell Range is three columns, (and a header for human consumption.) column 1 is for Bill Names, column 2 for bill Amounts and Columns(3).Cells(1) for the date, and Columns(3).Cells(2) for the bill amounts total for that date.

You can Name each Set of 3 Columns as a Named Range, and Use Range("CalendarCell1").Columns(1) for Bills And Range("CalendarCell1").Cells(3) for the Date, .Cells(6) for the total.

Dim NextBill As Range
Dim CalendarCell As Range
Set CalendarCell = Range("CalendarCell" & Day(Date) + FirstCalendarCell -1)
Set NextBill = CalendarCell.Columns(1).Cells(Cells.Count).End(xlUp).Offset(-1, 0)
NextBill.Value = "BillName"
NextBill.Offset(0, 1).Value = BillAmount
You can use StepCounting of Columns to find the DateCell of the CalendarCell Range

Set DateCell = Cells(2, (Day(Date) + FirstCalendarCell -1) * 3)
Set BillCell = Columns(DateCel.Column - 2).Cells(Cells.Count).End(xlUp).Offset(-1, 0))
Once the Table has been initalized with a date in all the right DateCells, you can use Find

Sub Init()
D = 1
For C = (Day(Date) + FirstCalendarCell -1) to 42 Step 3
Cells(2, c) = D
D = D + 1
If D > DaysInMonth Then Exit sub)
Next C
end sub

Set DateCell = Range(2:2).Find(Date)

2: I would use a VBA UserForm for the Calendar and the CalendarTable sheet as a permanent record. You can use one sheet as the Calendar, but it makes Counting cells a task, you have to use some form of stepcounting, even if the only 2 cells in each CalendarTableCell are Date And Bills.

3: The limit to the total rows per Calendar Cell is based on the usage of a Sheet cell for each bill. There is no limit if all Bills are in the same Sheet Cell and the subtoal comes from the values in a table. On a sheet Calendar the Sheet Rows will expand per the number of Bills. On a VBA UrserForm, the CalendarCells Bills Comboxes will have ScrollBars.

End: These are all just suggestions, theres a thousand ways to skin VBA.

mperrah
08-25-2015, 12:04 PM
Outstanding help from both of you!
I had a working workbook and was uploading when my company decided to do power testing...
I'll upload it shortly.
Just wanted to say thank you for the dedication and support. SamT (is that Sam Terrific?) and p45cal (pistol 45 caliber?)
-mark

mperrah
08-25-2015, 12:41 PM
14254
Here is a file that is pretty close to what I envisioned a while back.
(It's much better then I planned thanks to SamT and p45cal)

A big Thank You to you both for all your help.
Hope this helps someone else in the process.

-mark