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:
The macro:
Factors considered in the macro:
Any help will be greatly appreciated.
Many thanks
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:
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 | |||||||
---|---|---|---|---|---|---|---|
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