Compile error: Procedure too large

J

JakeNaude

New Member
Joined
Apr 15, 2020
Messages
16
Office Version
  1. 365
Platform
  1. Windows
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:
Capture - buttons.JPG


Sample Data:
Revised Station Progress Tracker II - 0.63.xlsm
FGHIJ
503Device (HPR001)In ProgressHPR NameHPR001
504HPR Location [SID]3/416
505HPR Room NameToilet
506HPR Network CabinetZDC6
507Shift Staff3staff
508Shift Budget (Planned)2shifts
509Shift Actual2shifts
510Estimated Remaining Shifts1shifts
511Estimated Remaining Shifts (Over Budget)1shifts
512Shifts Over Budget (Closing Actual)0shifts
513Shifts Under Budget (Closing Actual)0shifts
514Total Man Shifts (Actual)6man/shifts
515Task 1100%
516Task 2100%
517Task 3100%
518Task 4100%
519Task 5100%
520Task 6100%
521Task 7100%
522Task 8100%
523Task 9100%
524Task 10100%
Shift Data
Cell Formulas
RangeFormula
F503F503="Device ("&A504&")"
G503G503=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!")))))
I509I509=COUNTA(L505:CY505)
I510I510=IF(SUM(L504:CY504)=0,0,LOOKUP(2,1/(ISNUMBER(L504:CY504)),L504:CY504))
I511I511=IF(I510=0,0,IF(I510>(I508-COUNT(L504:CY504)),(I509-I508+I510),0))
I512I512=IF(AND(I524="Yes",(I509-I508)>0),I509-I508,0)
I513I513=IF(AND(I524="Yes",(I509-I508)<0),I508-I509,0)
I514I514=COUNTA(L505:CY514)
I521:I524,I516:I519I516=CZ516
Cells with Conditional Formatting
CellConditionCell FormatStop If True
G503:G524Cell Value="Oops... Entered data not making sense!"textNO
G503:G524Cell Value="Installed - Tasks In Progress"textNO
G503:G524Cell Value="not planned"textNO
G503:G524Cell Value="pending"textNO
G503:G524Cell Value="in progress"textNO
G503:G524Cell Value="Installed - Tasks Completed"textNO


The macro:

VBA Code: 
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
CDEFG
10Button NameValue = 0Value > 0Value Reference Cell/Range
11SBDC1 GreyLight blueI24
12SFC1GreyLight blueI486
13ZDC1 to ZDC20GreyLight blueI46, I68, I90… I464(every 22nd row downward)
14FIB1 to FIB40GreyGreenI2268, I2290, I2312… I3126(every 22nd row downward)
15LPR1 to LPR180GreyBlueI3148, I3170, I3192… I7086(every 22nd row downward)
16POW1 to POW40GreyOrangeI1388, I1410, I1432... I2246(every 22nd row downward)
17HPR1 to HPR40GreyBrownI508, I530, I552… I1366(every 22nd row downward)
18JUM1 to JUM40GreyPurpleI7108, I7130, I7152… I7966(every 22nd row downward)
Sheet1



Any help will be greatly appreciated.

Many thanks :)
 
Sort by date Sort by votes
How about
VBA Code: 
Set JUMshp = ActiveSheet.Shapes(Target.Offset(-4, -4).Value)
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Fluff said:
How about
VBA Code: 
Set JUMshp = ActiveSheet.Shapes(Target.Offset(-4, -4).Value)
Click to expand...

Hi Fluff,

Thanks... That did the trick... All buttons responding to the following code i.e. 0=grey >0=purple.

I'm sure I can figure out how to make the non-purple buttons respond to 0=grey >0=original colour.

Many thanks indeed!!! (y) (y) (y)

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim shp As Shape

   Set shp = ActiveSheet.Shapes(Target.Offset(-4, -4).Value)

   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(112, 48, 160)
           .Line.ForeColor.RGB = RGB(163, 101, 209)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
   End If

End Sub
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0
Fluff said:
Glad we could help & thanks for the feedback
Click to expand...

SOLVED!

Hi Fluff,

Thank you so much for your tips and guidance... The code works perfectly! Many thanks... (y)

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim shp As Shape

   Set shp = ActiveSheet.Shapes(Target.Offset(-4, -4).Value)

   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
   
   If shp.Name Like "LPR#" Or shp.Name Like "LPR##" Or shp.Name Like "LPR###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(0, 112, 192)
           .Line.ForeColor.RGB = RGB(0, 32, 96)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
   
   Else
   
   If shp.Name Like "JUM#" Or shp.Name Like "JUM##" Or shp.Name Like "JUM###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(112, 48, 160)
           .Line.ForeColor.RGB = RGB(163, 101, 209)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
      
   Else
   
   If shp.Name Like "HPR#" Or shp.Name Like "HPR##" Or shp.Name Like "HPR###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(191, 143, 0)
           .Line.ForeColor.RGB = RGB(128, 96, 0)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
      
   Else
   
   If shp.Name Like "POW#" Or shp.Name Like "POW##" Or shp.Name Like "POW###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(255, 192, 0)
           .Line.ForeColor.RGB = RGB(128, 96, 0)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(128, 96, 0)
       End With
      
   Else
   
   If shp.Name Like "FIB#" Or shp.Name Like "FIB##" Or shp.Name Like "FIB###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(0, 176, 80)
           .Line.ForeColor.RGB = RGB(55, 86, 35)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
      
   Else
   
   If shp.Name Like "ZDC#" Or shp.Name Like "ZDC##" Or shp.Name Like "SBDC#" Or shp.Name Like "SFC#" Then
       With shp
           .Fill.ForeColor.RGB = RGB(91, 155, 213)
           .Line.ForeColor.RGB = RGB(47, 82, 143)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
      
   End If
   End If
   End If
   End If
   End If
   End If
   End If

End Sub
 
Upvote 0
Norie said:
Can you post the code you were using for the 'JUM' buttons?
Click to expand...

SOLVED!

Hi Norie,

Many thanks for your assistance... The code works perfectly!!! (y) (y) (y)

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim shp As Shape

   Set shp = ActiveSheet.Shapes(Target.Offset(-4, -4).Value)

   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
   
   If shp.Name Like "LPR#" Or shp.Name Like "LPR##" Or shp.Name Like "LPR###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(0, 112, 192)
           .Line.ForeColor.RGB = RGB(0, 32, 96)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
   
   Else
   
   If shp.Name Like "JUM#" Or shp.Name Like "JUM##" Or shp.Name Like "JUM###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(112, 48, 160)
           .Line.ForeColor.RGB = RGB(163, 101, 209)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
      
   Else
   
   If shp.Name Like "HPR#" Or shp.Name Like "HPR##" Or shp.Name Like "HPR###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(191, 143, 0)
           .Line.ForeColor.RGB = RGB(128, 96, 0)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
      
   Else
   
   If shp.Name Like "POW#" Or shp.Name Like "POW##" Or shp.Name Like "POW###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(255, 192, 0)
           .Line.ForeColor.RGB = RGB(128, 96, 0)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(128, 96, 0)
       End With
      
   Else
   
   If shp.Name Like "FIB#" Or shp.Name Like "FIB##" Or shp.Name Like "FIB###" Then
       With shp
           .Fill.ForeColor.RGB = RGB(0, 176, 80)
           .Line.ForeColor.RGB = RGB(55, 86, 35)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
      
   Else
   
   If shp.Name Like "ZDC#" Or shp.Name Like "ZDC##" Or shp.Name Like "SBDC#" Or shp.Name Like "SFC#" Then
       With shp
           .Fill.ForeColor.RGB = RGB(91, 155, 213)
           .Line.ForeColor.RGB = RGB(47, 82, 143)
           .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
       End With
      
   End If
   End If
   End If
   End If
   End If
   End If
   End If

End Sub
 
Upvote 0
Glad you got it sorted & thanks for letting us know.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
How to Make this Macro work Fast?
Replies
2
Views
483
Georgiboy
Georgiboy
gravanoc
  • Question Question
Doughnut chart in Gauge chart not always set to correct axis group
Replies
0
Views
415
gravanoc
gravanoc
E
  • Question Question
Can anyone help me get my VBA code working? I have spent tons of time but can't quite fix it.
Replies
3
Views
3K
profray
P
K
  • Question Question
This is either an "existing connections" issue or a spreadsheet issue
Replies
1
Views
305
kaywai
K
A
  • Question Question
Help with existing code in Post - VBA to Create Org Chart
Replies
1
Views
2K
mrpotato562
M

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top