VBA Code Revision / Exit For Loop for desired result?

[Lil Stinker]

Hey folks,
I'm hoping you folks can provide some expertise here. I am designing a monthly calendar system in Excel. The code I have works well to enter the event time and title in a rectangular shape and place that shape in the appropriate matching date column on the calendar. The issue I'm having is I want to limit the number of shapes on any given date to 5 and have an additional shape appear to indicate if there are more than 5 events on that date, click here to see all events, essentially. The problem with the existing code is even with a Long variable setting the Daily Event Count to 5 (dayevntCOUNT), it continues creating the shapes for every event logged for that date and piles them on top of each other which messes up the time-of-day order displayed. The same occurs to the additional shape, the "more" button, which gets replicated for the same number of events there are on that date.

I didn't write the code, I've only tweaked it to include adding a "more" button. I've tried jumping out of the For loop in several locations in the code but nothing seems to limit the event shapes to 5 and the more shape to 1. I'm stumped so any help would be appreciated.

Sub CALrefresh()

'''clear all existing events from month schedule'''
    For Each evntSHP In Schedule.Shapes
        If InStr(evntSHP.Name, "CALevnt") > 0 Then evntSHP.Delete
    Next evntSHP
 
'''refresh calendar with daily events sorted by date & time from schedule record'''   
    evntNUM = 1 'set default event # to 1
    With SCHrecord
        lastROW = .Range("A1048576").End(xlUp).Row 'last item row
        If lastROW < 3 Then Exit Sub
Application.ScreenUpdating = False
        .Range("A2:Q" & lastROW).AdvancedFilter xlFilterCopy, CriteriaRange:=.Range("W1:X2"), CopyToRange:=.Range("AA2:AQ2"), Unique:=True
        lastresROW = .Range("AA99999").End(xlUp).Row 'last result row
        If lastresROW < 3 Then Exit Sub
        If lastresROW < 4 Then GoTo SkipSort
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=SCHrecord.Range("AC3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'sort based on start date
                .SortFields.Add Key:=SCHrecord.Range("AI3"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 'then sort based on all day event
                .SortFields.Add Key:=SCHrecord.Range("AE3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'then sort based on start time
                .SetRange SCHrecord.Range("AA3:AQ" & lastresROW) 'set result range
                .Apply
            End With
SkipSort:
        For resROW = 3 To lastresROW
            evntID = .Range("AA" & resROW).Value 'event id
            evntNAME = .Range("AB" & resROW).Value 'event title
            evntDATE = .Range("AC" & resROW).Value 'event start date
            evntTIME = Format(.Range("AE" & resROW).Value, "h:mma/p") 'event time formatted
            evntCAT = .Range("AJ" & resROW).Value 'category
            evntCOLOR = Schedule.Range("AM2").Interior.Color 'shape color
            dayevntCOUNT = Application.WorksheetFunction.CountIf([CALstdayresults], evntDATE) 'get number of events on single day
            If dayevntCOUNT > 5 Then dayevntCOUNT = 5 'set event limit to 5

'''create event shapes and position on matching dates'''
            For calROW = 9 To 39 Step 6
                For calCOL = 4 To 16 Step 1
                    If Schedule.Cells(calROW, calCOL).Value = evntDATE Then 'day found
                        Schedule.Shapes("CALeventsample").Duplicate.Name = "CALevnt" & evntID
                        With Schedule.Shapes("CALevnt" & evntID)
                            .Left = Schedule.Cells(calROW, calCOL).Left + 1 'left position
                            .Top = Schedule.Cells(calROW - 6 + evntNUM, calCOL).Top + 1
                            .Width = Schedule.Cells(calROW + evntNUM, calCOL + 1).Width + 28
                            .Height = Schedule.Cells(calROW + evntNUM, calCOL).Height - 4
                            .TextFrame2.TextRange.Text = evntTIME & " | " & evntNAME 'text inside shape
                            .Fill.ForeColor.RGB = evntCOLOR 'set event color
                        End With
                        If dayevntCOUNT > 5 And Schedule.Cells(calROW, calCOL).Value = evntDATE Then Schedule.Shapes("CALeventmore").Duplicate.Name = "CALevntMR"
                            On Error Resume Next
                            With Schedule.Shapes("CALevntMR")
                                .Left = Schedule.Cells(calROW, calCOL + 1).Left + 80 'left position
                                .Top = Schedule.Cells(calROW, calCOL).Top - 5 'top position
                            End With
                            On Error GoTo 0
                        If evntNUM >= dayevntCOUNT Then
                            If evntNUM > 5 Then GoTo NextDay
                            evntNUM = 1
                        Else
                            evntNUM = evntNUM + 1 'increment by 1
                        End If
                    End If
                Next calCOL
            Next calROW
NextDay:
        Next resROW
    End With
Application.ScreenUpdating = True
End Sub

 

[Micron]

All I can suggest is that you step through your code (F8) and check variable values and conditions as you go. Your code shows at least one undeclared variable (dayevntCOUNT >) unless it is declared elsewhere, so it's hard to know what it might contain at any point. Also, it would seem that variable has to do with your issue, and while its value is being tested (>5) I don't see where it is ever incremented. In that case it is probably always zero (0). Stepping through and watching what happens should show you where the problem is, or if indeed that is the problem.

 

[Lil Stinker]

Thanks for your reply!

dayevntCOUNT is declared as a long variable. It gets its count initially from the Named Range CALstdateresults which is a dynamic, filtered range of start dates for monthly events. After getting the initial count of events for any given day using CountIF, if the number of events is > 5, dayevntCOUNT is set to 5 to limit the number of event shapes displayed for the corresponding day on the calendar (equivalent to five rows per day). However, instead of stopping at 5, it continues to produce any remaining event shapes for that day, positioning them back at the top and covering over the first 5 events produced for that day.

I’ve stepped through it numerous times and it appears all the variables equal the correct values at the appropriate intervals which is why I’m stumped. I’ve tried exiting the For and using GoTo NextDay: but they either result in no shapes displaying or all of the shapes stacked on top of each other but never just 5 total shapes.

I’m still pretty green at Excel and VBA. If there is some other alternative to interrupting the loop, I’m all ears. I’m just taking shots in the dark.

 

[Micron]

For me this is one of those things that is not obvious (especially if I can't see relevant code) and requires some investigation. However, there's too many elements to recreate the wheel at my end in order to be able to do that. If you want to post a file somewhere I should be able to find the time to take a look in between everything else that's going on. This is our Thanksgiving weekend, we have visitors staying, I'm the primary cook about 2 times a day plus I'm doing a woodworking project (60" long cabinet). Yet here I am now . . .

 

[Lil Stinker]

Oh, well, Happy Thanksgiving!
This is going to sound funny but I’ve never posted a file before. Where would I do this? I usually use XL2BB to provide sheet samples but it started causing catastrophic failures in my Excel so I deleted it.

 

[Akuini]

This is going to sound funny but I’ve never posted a file before. Where would I do this? I usually use XL2BB to provide sheet samples but it started causing catastrophic failures in my Excel so I deleted it.

You could upload a sample workbook (without sensitive data) to a file-sharing site like Dropbox.com or Google Drive, and then share the link here.
Also, ensure that the link is accessible to anyone.

 

[Lil Stinker]

Akuini, thanks for the assist. I hope I've done this correctly.

Micron, here's the sample file. It's a work in progress so nothing on the worksheet actually works yet. I spent the weekend going over it several dozen more times and still cannot find a way to stop the loop at the appropriate time. I did manage to get the "more" button to appear correctly and not duplicate more than necessary but the event shapes continue despite every attempt to limit them to 5 max per day. Based on the sample set of events loaded into the Schedule Record on Sheet 2, September 30th is the only example currently with multiple events for the day. I have several helper cells in columns A:B, AH:AM and several Named Ranges. If you need to change the month view for any reason, simply enter the month number into A8.

Thanks in advance for your assistance.

CALENDAR - sample code test.xlsm

 

[Micron]

Aren't these 2 things counter intuitive?

I want to limit the number of shapes on any given date to 5

and have an additional shape appear to indicate if there are more than 5 events on that date

If you were successful in achieving a limit of 5 there would be no need to indicate that there were more than 5 so isn't the latter part redundant? I think that's an important issue that needs to be addressed first.

I managed to download your file this morning as an xlsm file and probably could start looking at it later this afternoon or evening. If anyone reading this wants to beat me to it, feel free.

 

[Micron]

It's a work in progress so nothing on the worksheet actually works yet.

Can you elaborate on that while addressing the aforementioned items? I cannot see anything that calls the code you posted, so you are running it manually for now?
To test, all I have to do is start that code - or do a sheet change or selection change?

EDIT - your selection change code alters cell values, which triggers the change event. You could end up in a infinite loop doing that. Are you sure you want selection change to call change event?

 

[Lil Stinker]

Apologies for the confusion. The Selection Change events on the sheet are the only elements that are functional, and they pertain to some visual effects. Two checkboxes, Recurring Dates and All Day events. When you click on those cells, they sel change event changes the box from unchecked to checked (in effect, changing the value in that cell from Wingdings Chr 111 to Chr 254) and changes conditional formatting in the recurring dates section while the all day checkbox also adds in default time values for the start and end time. The other sel change event displays or hides some drop shadow shapes once a query is entered in the search field on the sheet.

I meant none of the button shapes on the calendar display sheet work. So, you can't "scroll" through 'previous' or 'next' month or change views between month, week, day or year, for example. I wanted to resolve this first issue before moving forward. To clarify the issue: on the SCH Record sheet, September 30th has 9 events logged. The macro, which I've been running manually during the testing phase, takes those 9 events and copies them into text shapes and positions them on the corresponding day. Each day on the calendar display only allows for 5 rows of events. The day number formula is set along with empty space for a holiday matching formula in the sixth row. So as not to cover up the day number, the event shapes are limited in the macro to display 5 shapes but then it resets the shape position to 1 which takes events 6-9 back to the top row of the day subsequently covering over events 1-5. I would like to stop the macro from creating event shapes at 5 regardless of how many events there are recorded for the day and then display a 6th icon shape (positioned in the empty space to the right of the day number) which represents more events exist for the day but are not visible on the month view. Later, I plan to write a macro for the icon shape that will take the user to a day view where all of the events for the day can be seen listed in full.

I hope that answers your questions.

Here's what it currently does (I moved the unwanted shapes off to the side):

Here's what I would like it to do: