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]

Betcha I spent 2 hours stepping through this code to watch what is going on.

If evntNUM = 5 Then

you're creating the ballon shape with the ellipses. Do you want that if the count is only 5? Shouldn't it be created only if dayevntCOUNT >5 ?

OK, so this (don't worry about my indentation or seemingly missing If's and such because I've clipped from your code):

If dayevntCOUNT > 5 Then dayevntCOUNT = 5 'set event limit to 5

Doesn't seem to help because when it comes to creating shapes it has been reset (and I think that is the crux of your problem):

   If evntNUM >= dayevntCOUNT Then
      evntNUM = 1 'reset <<<<<<<<<<<<
      GoTo NextDay
   Else
      evntNUM = evntNUM + 1 'increment by 1
   End If
End If
Next calCOL
Next calROW
            'On Error GoTo 0
NextDay:
  Next resROW

So basically, you just repeat the placements for another 5 shapes because the counting starts all over again. I believe the solution is to not reset the variable first and foremost. Then the logic would be
- if a count (not sure which but it's the one that increments with the creation of shapes) <6 then create the new shape
- if a count is 6 create the balloon shape
- if a count > 6 exit sub? Create subsequent shapes on another sheet? Can't recall if you said what that action would be.

I think I would use a Select Case block for that test and call subs that are specific to the action to be take if there is in fact a 3rd action. The Case statements would run other subs to keep things from getting too jumbled together. Another thought I had was to use a loop that limits shape creation to perhaps 6, but I think you'd still have to test for 5 vs 6 so the Select Case block might be better. Besides, you've already got 3 loops going, which is probably confusing enough.

 

[Lil Stinker]

Betcha I spent 2 hours stepping through this code to watch what is going on.

Oh man, I spent 28 hours trying all sorts of variations of changing the limit from 5 to 6, trying Exit For's and GoTo's in multiple areas and stepping through every variation. As I mentioned in the beginning, I didn't write the code. I only adapted it to fit my calendar construct and added in the balloon shape with the ellipses. The code is rather maniacal from what I can tell but I'm not a coder.

Do you want that if the count is only 5? Shouldn't it be created only if dayevntCOUNT >5 ?

My coding experience begins with With's and ends at If's. That's about all I understand. I was using the hammer approach trying to hammer the code into submission and forcing it to stop at 5. If at any point in the code, I set the limit to 6 or left it an opening with >=5, it would create the "More" button (balloon shape w/ ellipses) and then place a sixth event shape on top of it. Or it would create the "More" button 9 times, correctly position one of the buttons on the day and leave the other 8 buttons floating mid-calendar. I left it at 'If evntNUM = 5' because it finally worked and didn't look back!

If dayevntCOUNT > 5 Then dayevntCOUNT = 5 'set event limit to 5

and

   If evntNUM >= dayevntCOUNT Then
      evntNUM = 1 'reset <<<<<<<<<<<<
      GoTo NextDay
   Else
      evntNUM = evntNUM + 1 'increment by 1
   End If
End If
Next calCOL
Next calROW
            'On Error GoTo 0
NextDay:
  Next resROW

actually work hand in hand to position the event shapes correctly on the day. When I comment out "If davevntCOUNT > 5 Then dayevntCOUNT = 5", I get all 9 event shapes listed inside the day and beyond:

   If evntNUM >= dayevntCOUNT Then
      evntNUM = 1 'reset <<<<<<<<<<<<

This is imperative because otherwise, it just places all the remaining event shapes in the fifth row on top of event shape 5. It needs to reset the position back to 1 for any events that follow on subsequent days. For example, if 6 of these events appeared on 9/29 and the remaining 3 appeared on 9/30, those 3 event shapes would all be positioned in the fifth row of 9/30 all on top of each other again. No bueno. That's why I thought throwing in a GoTo NextDay would work to Exit the loop for the day's events but, nope. And Exiting the Sub would be bad because then it doesn't continue placing events for any remaining days for the month.

As for Select Case, I'm only starting to understand how those work. I understand the logic of them but not the language well enough to write them myself.

 

[Micron]

Better that you google Select Case than me spending 15 minutes writing about it. Some, 2 minutes. Me, well I tend to cover every nuance of something.
Your need may be imperative for the reasons you give, but the usage of it seems to be a problem in your context. All I can tell you at this point is that I'm fairly certain the reset is your issue, so perhaps you need another nested loop that runs until 6 (?), or another variable that doesn't get reset - at least not until the problem you're trying to avoid is handled. Or a Select Case block to call subs that do one thing (continue to add shapes) or the other, whatever that turns out to be.

 

[Lil Stinker]

I'm not skilled enough to code it alone but thanks for your suggestions.

If anyone else out there is willing to tackle this beast with some code revision, I'd appreciate it.
Here's the link again:
CALENDAR - sample code test.xlsm

 

[Micron]

I was under the impression you could follow through but after reviewing all your posts I see where you've said otherwise. So to summarize for me or anyone else, no more than 5 event shapes should be created. On the 6th pass (if there is a 6th) the balloon shape should be positioned beside the day number and then the code should exit. Is that right?

If anyone chimes in to help, perhaps take note of post 11 for some guidance.

 

[Lil Stinker]

Currently, I have the balloon shape appearing as part of the 5th pass, immediately after creating the 5th event shape. That seems to work just fine. The bottom line is there should be no more than 5 event shapes created for any given day. After placing the balloon shape beneath the 5th and final shape, the code should progress to the next day’s events if any or end if it’s the last day of the month.

 

[Micron]

Hope you can forgive the questions, because there are meant to eliminate comebacks like
"Thanks BUT now my users are complaining that there is this indicator that something is true when it isn't. Can you fix my code?"
( Like in your case, clicking the shape to see that there are more than 5 events only to find out that there are not. )
TBH I don't respond to 'comebacks' like that, just so you know.

Why would you not only do this if dayevntCOUNT is greater than 5?

Not sure I will be successful but will try to figure it out in between everything that's going on around here.

 

[Lil Stinker]

Why would you not only do this if dayevntCOUNT is greater than 5?

Okay, so technically, the way it should work is if there are 6 or more events, display only 5 event shapes and add balloon shape. Otherwise, if only 5 events, display 5 event shapes, no balloon shape. However, while the dayevntCOUNT counts the number of events using the CountIf function, it appears to have a dual purpose in determining how many event shapes appear on the day which is why it is limited to 5. Whenever I tried limiting it to 6, it displayed 6 event shapes on the day and covered up my balloon shape.