Dynamic width of the shape based on the day of the month [VBA]

[Martin_H]

Hi team,

I am looking for a help with this one.

If today is the first day of the month, then make Rectangle 1 = 0 cm width.
If today is the second day of the month, then make Rectangle 1 to cover the range area D6:D33.
If today is the third day of the month, then make Rectangle 1 to cover the range area D6:E33.
If today is the fourth day of the month, then make Rectangle 1 to cover the range area D6:F33.
If today is the fifth day of the month, then make Rectangle 1 to cover the range area D6:G33.
If today is the sixth day of the month, then make Rectangle 1 to cover the range area D6:H33.
... and so on till the last day of the month.

Rectangle 1 is just a basic Excel Rectangle shape.


Thank you very much.

 

[dmt32]

Have you made any changes to code as it produces that result for me - what result are you getting?
Helpful if you post copy of your worksheet using MrExcel xl2BB addin.

Dave

 

[Martin_H]

Have you made any changes to code as it produces that result for me - what result are you getting?
Helpful if you post copy of your worksheet using MrExcel xl2BB addin.

Dave

I have not made any changes to your code @dmt32.

This is the result for month of December 2021 (see the screenshot below) when using your code. First two days should be covered by the rectangle but they are not.

For any past months or future months your code seems to work just fine.

 

[dmt32]

I have assumed that your ranges are all contiguous & my Little test I did below seems to work ok.

Cannot offer any further insight - you will either need to post copy of your worksheet using mrexcel xl2BB addin or place copy of your workbook in a file sharing site like dropbox & provide link to it.

Dave

 

[MartinS]

OK, to fix this, set intDayOfMonth = 0 instead of intDayOfMonth = 1, i.e.

    'Set the variable value if the dates don't match
    If DateSerial(Year(rngMonthDate.Value), Month(rngMonthDate.Value), 1) > DateSerial(Year(Now), Month(Now), 1) Then
        intDayOfMonth = 0
    ElseIf DateSerial(Year(rngMonthDate.Value), Month(rngMonthDate.Value), 1) < DateSerial(Year(Now), Month(Now), 1) Then
        intDayOfMonth = intDaysInMonth
    End If

 

[Martin_H]

@MartinS

I have recorded a short clip click here to watch it.

I am using your code with Case value 0.

As you can see in the clip, first month was November 2021 (all good), second one was December 2021 (all good), third one was January 2022 (not good), focus on that first column, which is the first day of January 2022, the column, as you can see, is covered by the rectangle.

 

[Martin_H]

OK, to fix this, set intDayOfMonth = 0 instead of intDayOfMonth = 1, i.e.

    'Set the variable value if the dates don't match
    If DateSerial(Year(rngMonthDate.Value), Month(rngMonthDate.Value), 1) > DateSerial(Year(Now), Month(Now), 1) Then
        intDayOfMonth = 0
    ElseIf DateSerial(Year(rngMonthDate.Value), Month(rngMonthDate.Value), 1) < DateSerial(Year(Now), Month(Now), 1) Then
        intDayOfMonth = intDaysInMonth
    End If

So far so good. Thank you @MartinS