Compile error: Procedure too large

[JakeNaude]

Hi,

Thanks for this fantastic forum... I often come here for excel/macro related answers but this is my first post!

Please could someone help me shorten my Excel 365 macro running on Windows 10

I ran into trouble when I started building a Worksheet_Change macro to change the colour of the buttons based on their cell values i.e. value = 0 makes button grey and value >0 gives button colour.

I get the compile error: Procedure too large in my Worksheet_Change(ByVal Target As Range) macro in Sheet29 (Shift Data) and need a hand shortening my code.

I have an 8000 row sheet which consists of many 22 row segments to collect Shift Data from engineers. To aid navigation I have about 300 shape "buttons" that filter to relevant 22 row segments.

Button names: SBDC1, SFC1, ZDC1 to ZDC20, FIB1 to FIB40, LPR1 to LPR180, POW1 to POW40, HPR1 to HPR40, JUM1 to JUM40

The buttons:

Sample Data:

Revised Station Progress Tracker II - 0.63.xlsm
	F	G	H	I	J
503	Device (HPR001)	In Progress	HPR Name	HPR001
504			HPR Location [SID]	3/416
505			HPR Room Name	Toilet
506			HPR Network Cabinet	ZDC6
507			Shift Staff	3	staff
508			Shift Budget (Planned)	2	shifts
509			Shift Actual	2	shifts
510			Estimated Remaining Shifts	1	shifts
511			Estimated Remaining Shifts (Over Budget)	1	shifts
512			Shifts Over Budget (Closing Actual)	0	shifts
513			Shifts Under Budget (Closing Actual)	0	shifts
514			Total Man Shifts (Actual)	6	man/shifts
515			Task 1	100%
516			Task 2	100%
517			Task 3	100%
518			Task 4	100%
519			Task 5	100%
520			Task 6	100%
521			Task 7	100%
522			Task 8	100%
523			Task 9	100%
524			Task 10	100%
Shift Data

Cell Formulas
Range	Formula
F503	F503	="Device ("&A504&")"
G503	G503	=IF(AND(I508>0,I510=0,I514>0,CZ503=1,I515=1,I516=1,I517=1,I518=1,I519=1,I520=1,I521=1,I522=1,I523=1,I524=1),"Installed - Tasks Completed", IF(AND(I508>0,I510>=0,I514>0,CZ503=1,OR(I515<1,I516<1,I517<1,I518<1,I519<1,I520<1,I521<1,I522<1,I523<1,I524<1)),"Installed - Tasks In Progress", IF(AND(I508>0,I510>0,I514>0,CZ503<1),"In Progress", IF(AND(I508>0,I510=0,I514=0),"Pending", IF(I508=0,"Not Planned", "Oops... Entered data not making sense!")))))
I509	I509	=COUNTA(L505:CY505)
I510	I510	=IF(SUM(L504:CY504)=0,0,LOOKUP(2,1/(ISNUMBER(L504:CY504)),L504:CY504))
I511	I511	=IF(I510=0,0,IF(I510>(I508-COUNT(L504:CY504)),(I509-I508+I510),0))
I512	I512	=IF(AND(I524="Yes",(I509-I508)>0),I509-I508,0)
I513	I513	=IF(AND(I524="Yes",(I509-I508)<0),I508-I509,0)
I514	I514	=COUNTA(L505:CY514)
I521:I524,I516:I519	I516	=CZ516

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
G503:G524	Cell Value	="Oops... Entered data not making sense!"	text	NO
G503:G524	Cell Value	="Installed - Tasks In Progress"	text	NO
G503:G524	Cell Value	="not planned"	text	NO
G503:G524	Cell Value	="pending"	text	NO
G503:G524	Cell Value	="in progress"	text	NO
G503:G524	Cell Value	="Installed - Tasks Completed"	text	NO

The macro:

Private Sub Worksheet_Change(ByVal Target As Range)
    
'******************************
' Fibre button colours - on/off
'******************************
    
    If Range("I2268").Value = 0 Then
        With ActiveSheet.Shapes("FIB1")
            .Fill.ForeColor.RGB = RGB(230, 230, 230)
            .Line.ForeColor.RGB = RGB(179, 179, 179)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(179, 179, 179)
        End With
    Else
        With ActiveSheet.Shapes("FIB1")
            .Fill.ForeColor.RGB = RGB(0, 176, 80)
            .Line.ForeColor.RGB = RGB(50, 103, 50)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End With
    End If

    If Range("I2290").Value = 0 Then
        With ActiveSheet.Shapes("FIB2")
            .Fill.ForeColor.RGB = RGB(230, 230, 230)
            .Line.ForeColor.RGB = RGB(179, 179, 179)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(179, 179, 179)
        End With
    Else
        With ActiveSheet.Shapes("FIB2")
            .Fill.ForeColor.RGB = RGB(0, 176, 80)
            .Line.ForeColor.RGB = RGB(50, 103, 50)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End With
    End If

    If Range("I2312").Value = 0 Then
        With ActiveSheet.Shapes("FIB3")
            .Fill.ForeColor.RGB = RGB(230, 230, 230)
            .Line.ForeColor.RGB = RGB(179, 179, 179)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(179, 179, 179)
        End With
    Else
        With ActiveSheet.Shapes("FIB3")
            .Fill.ForeColor.RGB = RGB(0, 176, 80)
            .Line.ForeColor.RGB = RGB(50, 103, 50)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End With
    End If

    If Range("I2334").Value = 0 Then
        With ActiveSheet.Shapes("FIB4")
            .Fill.ForeColor.RGB = RGB(230, 230, 230)
            .Line.ForeColor.RGB = RGB(179, 179, 179)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(179, 179, 179)
        End With
    Else
        With ActiveSheet.Shapes("FIB4")
            .Fill.ForeColor.RGB = RGB(0, 176, 80)
            .Line.ForeColor.RGB = RGB(50, 103, 50)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End With
    End If

    'etc, etc, etc

End Sub

Factors considered in the macro:

Book1.xlsm
	C	D	E	F	G
10	Button Name	Value = 0	Value > 0	Value Reference Cell/Range
11	SBDC1	Grey	Light blue	I24
12	SFC1	Grey	Light blue	I486
13	ZDC1 to ZDC20	Grey	Light blue	I46, I68, I90… I464	(every 22nd row downward)
14	FIB1 to FIB40	Grey	Green	I2268, I2290, I2312… I3126	(every 22nd row downward)
15	LPR1 to LPR180	Grey	Blue	I3148, I3170, I3192… I7086	(every 22nd row downward)
16	POW1 to POW40	Grey	Orange	I1388, I1410, I1432... I2246	(every 22nd row downward)
17	HPR1 to HPR40	Grey	Brown	I508, I530, I552… I1366	(every 22nd row downward)
18	JUM1 to JUM40	Grey	Purple	I7108, I7130, I7152… I7966	(every 22nd row downward)
Sheet1

Any help will be greatly appreciated.

Many thanks

 

[mole999]

worksheet change is the likely trouble maker, copy the whole thing out to word and save it. put half back and see if it compiles.

you will probably need to add additional subs that are called from that module to get below the upper limit

 

[steve the fish]

Tell us how this works. You change a value and you want to change colour of a button. How is it changed? Manually or is it a formula? If it manually and thats how worksheet change works then you just need to concern yourself with the correct cell and therefore the correct button. You dont need to be changing the colour of all the buttons at each change. That is cumbersome.

 

[Norie]

Why not use the click events of the buttons to execute the code rather than the worksheet change event?

You might actually be able to use the same code for all the buttons.

 

[JakeNaude]

worksheet change is the likely trouble maker, copy the whole thing out to word and save it. put half back and see if it compiles.

you will probably need to add additional subs that are called from that module to get below the upper limit

Hi mole999,

Thanks. Do you mean having multiple worksheet_change macros... Please forgive my ignorance...

 

[JakeNaude]

Tell us how this works. You change a value and you want to change colour of a button. How is it changed? Manually or is it a formula? If it manually and thats how worksheet change works then you just need to concern yourself with the correct cell and therefore the correct button. You dont need to be changing the colour of all the buttons at each change. That is cumbersome.

Hi Steve the Fish,

Thanks for your speedy response. I'd like the button colour to respond based on data being manually entered into the sheet. I see what your saying about changing the colour of all of the buttons each time. It is cumbersome. I'm sure there's a better way but I don't know how to apply the code to just one button/cell at a time? Cheers...

 

[JakeNaude]

Why not use the click events of the buttons to execute the code rather than the worksheet change event?

You might actually be able to use the same code for all the buttons.

Hi Norie,

Thanks for responding. I'd like the buttons to react to data being manually entered into the sheet. I'm guessing that the click event would only show the colour change if the button is clicked. This could lead to situations where the data has been updated and the button wouldn't reflect the change until pressed? Have I got that right?

 

[Fluff]

One way to slim it down would be

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Shp As Shape
   Select Case Target.Address(0, 0)
      Case "I2268"
         Set Shp = ActiveSheet.Shapes("FIB1")
      Case "I2290"
         Set Shp = ActiveSheet.Shapes("FIB2")
      Case "I2312"
         Set Shp = ActiveSheet.Shapes("FIB3")
   End Select
   If Target.Value = 0 Then
       With Shp
           .Fill.ForeColor.RGB = RGB(230, 230, 230)
           .Line.ForeColor.RGB = RGB(179, 179, 179)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(179, 179, 179)
       End With
   Else
       With Shp
           .Fill.ForeColor.RGB = RGB(0, 176, 80)
           .Line.ForeColor.RGB = RGB(50, 103, 50)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
   End If

End Sub

 

[JakeNaude]

One way to slim it down would be

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Shp As Shape
   Select Case Target.Address(0, 0)
      Case "I2268"
         Set Shp = ActiveSheet.Shapes("FIB1")
      Case "I2290"
         Set Shp = ActiveSheet.Shapes("FIB2")
      Case "I2312"
         Set Shp = ActiveSheet.Shapes("FIB3")
   End Select
   If Target.Value = 0 Then
       With Shp
           .Fill.ForeColor.RGB = RGB(230, 230, 230)
           .Line.ForeColor.RGB = RGB(179, 179, 179)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(179, 179, 179)
       End With
   Else
       With Shp
           .Fill.ForeColor.RGB = RGB(0, 176, 80)
           .Line.ForeColor.RGB = RGB(50, 103, 50)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
   End If

End Sub

Hi Fluff,

Thanks for your response! This looks like the ticket... I think I get the idea... I'll have a go at building the other buttons and colours in too... I'll report back... Many thanks...

 

[mole999]

Hi mole999,

Thanks. Do you mean having multiple worksheet_change macros... Please forgive my ignorance...

You can only have one worksheet change macro, but it can call many others from within. The vba macro is size limited which is why you fall foul of too big