I have the below code that colors all the buttons (there are 10) grey to clear any previously colored button, and then colors the button selected blue. Basically acting as an indicator of what button is currently selected. I noticed that the code now takes a moment to run with this cosmetic addition and I was wondering if there is any way to re-write this to run faster?
Thank you for your help and please let me know if I can provide any more detail
'
' all_days Macro
'change all buttons to grey first
ActiveSheet.Shapes.Range(Array("Rectangle: Rounded Corners 17", _
"Rectangle: Rounded Corners 12", "Rectangle: Rounded Corners 11")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.5
.Transparency = 0
.Solid
End With
'change selected button to blue
ActiveSheet.Shapes.Range(Array("Rectangle: Rounded Corners 12")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
.Solid
End With
ActiveSheet.Range("$A$1:$X$740").AutoFilter Field:=12
ActiveSheet.Range("$A$1:$X$100000").AutoFilter Field:=17
End Sub```
Sub HighlightClickedShape()
Dim ShapeNames() As Variant
ShapeNames = Array("Rectangle: Rounded Corners 17", _
"Rectangle: Rounded Corners 12", "Rectangle: Rounded Corners 11")
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim shprg As ShapeRange: Set shprg = ws.shapes.Range(ShapeNames)
ResetShapeRange shprg
Dim shp As Shape
On Error Resume Next
Set shp = shprg(Application.Caller)
On Error GoTo 0
If shp Is Nothing Then
MsgBox "This only works when clicking on one of the following shapes:" _
& vbLf & vbLf & Join(ShapeNames, vbLf), vbCritical
Exit Sub
End If
HighlightShape shp
End Sub
Sub ResetShapeRange(ByVal shprg As ShapeRange)
With shprg.Fill.ForeColor
.ObjectThemeColor = msoThemeColorBackground1
.Brightness = -0.5
End With
End Sub
Sub HighlightShape(ByVal shp As Shape)
With shp.Fill.ForeColor
.ObjectThemeColor = msoThemeColorAccent1
.Brightness = -0.25
End With
End Sub