Speeding up button formatting in VBA - vba

Question

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```

Answer 1

Highlight Clicked Shape
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

Answer 2

I suspect that the Select is slowing down the process, and it is not necessary at all. Usually the code that the macro recorder is creating needs to be streamlined, especially it is always never needed to select something.
I created a sheet with nearly 100 shapes and the following code runs rather instantly (and my PC is 6 years old...). It loops over all shapes of a worksheet, checks if the shape should be colored by testing the name of it. This check is outsourced to a private function to make the code more readable - simply adapt the if-statement there. And if you want to color all shapes of the sheets, you can let the function return True in any case, no need to check the names.
In my version, the routine uses Application.Caller to find the shape that was clicked to paint it with blue - therefore you can use the same routine for all shapes.
Sub shapes()
Dim ws As Worksheet, sh As Shape
Set ws = ActiveSheet
For Each sh In ws.shapes
If isButtonShape(sh) Then
sh.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground2
End If
Next
On Error Resume Next
Set sh = Nothing
Set sh = ws.shapes(Application.Caller)
On Error GoTo 0
If Not sh Is Nothing Then
If isButtonShape(sh) Then
sh.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
sh.Fill.ForeColor.TintAndShade = 0
End If
End If
End Sub
Private Function isButtonShape(sh As Shape) As Boolean
isButtonShape = (sh.Name = "Rectangle: Rounded Corners 17" _
Or sh.Name = "Rectangle: Rounded Corners 12" _
Or sh.Name = "Rectangle: Rounded Corners 11")
End Function

Answer 3

This is the code that I ended up using
'change all buttons to grey first
Dim shapenames() As Variant
Dim ws As Worksheet: Set ws = ActiveSheet
shapenames = Array("Rectangle: Rounded Corners 17", "Rectangle: Rounded Corners 12", "Rectangle: Rounded Corners 11")
Dim shprg As ShapeRange: Set shprg = ActiveSheet.shapes.Range(shapenames)
With shprg.Fill.ForeColor
.ObjectThemeColor = msoThemeColorBackground1
.Brightness = -0.5
End With
'change selected button to blue
Dim shapename() As Variant
shapename = Array("Rectangle: Rounded Corners 12")
Set shprg = ActiveSheet.shapes.Range(shapename)
With shprg.Fill.ForeColor
.ObjectThemeColor = msoThemeColorAccent1
End With