VBA - Colour change buttons with timer

[Jasesair]

I am wanting to utilise colour changing buttons to essentially highlight a button when pressed. After 1 or 2 seconds, I'd like the button to revert back to the original colour. Is this possible? This is what I have so far...

Sub SetColor(v)
  Dim cell As String
  cell = ActiveCell.Address
  ActiveSheet.Shapes.SelectAll
  Selection.ShapeRange.Fill.ForeColor.RGB = RGB(175, 171, 171)
  ActiveSheet.Shapes(v).Fill.ForeColor.RGB = RGB(0, 204, 153)
  Range(cell).Activate
End Sub

Sub Offerings1()

    Application.ScreenUpdating = False
    Call SetColor(Application.Caller)

    Worksheets("Offerings").Range("c7,e7,g7,i7").Interior.ColorIndex = xlNone

End Sub

 

[Domenic]

You can set up a separate procedure to reset the button's color, and then use the OnTime method of the Application object to call that procedure after one second has elapsed. So, for example, place the following code in a regular module, and then try running it.

Option Explicit

'these two variables must be declared as Public variables
Public button As Shape
Public buttonColor As Long

Sub Offerings1()

    Application.ScreenUpdating = False
    
    Call SetColor(Application.Caller)

    Worksheets("Offerings").Range("c7,e7,g7,i7").Interior.ColorIndex = xlNone

End Sub

Sub SetColor(v)

  Dim cell As String
  cell = ActiveCell.Address
 
  Set button = ActiveSheet.Shapes(v)
 
  buttonColor = button.Fill.ForeColor.RGB
 
  ActiveSheet.Shapes.SelectAll
  Selection.ShapeRange.Fill.ForeColor.RGB = RGB(175, 171, 171)
 
  button.Fill.ForeColor.RGB = RGB(0, 204, 153)
 
  Application.OnTime Now() + TimeValue("00:00:01"), "'ResetButton button, buttonColor'" 'calls function after one second has elapsed (change as desired)
 
  Range(cell).Activate
 
End Sub

Public Sub ResetButton(ByVal button As Shape, ByVal buttonColor As Long)

    button.Fill.ForeColor.RGB = buttonColor
    
End Sub

Hope this helps!

 

[Domenic]

Actually, I would do it this way instead. First, insert a new regular module (Visual Basic Editor >> Insert >> Module), and then place the following code in the code module...

Option Explicit

'these two variables must be declared as Public variables
Public button As Shape
Public buttonColor As Long

Public Sub ResetButton(ByVal button As Shape, ByVal buttonColor As Long)

    button.Fill.ForeColor.RGB = buttonColor
    
End Sub

Then, right-click the sheet tab for the sheet containing your button and shapes, and then place the following code in the code module...

Option Explicit

Private Sub Offerings1()

    Call SetColor(Application.Caller)

    Worksheets("Offerings").Range("c7,e7,g7,i7").Interior.ColorIndex = xlNone

End Sub

Private Sub SetColor(v)

  Dim cell As String
  cell = ActiveCell.Address
 
  Set button = Me.Shapes(v)
 
  buttonColor = button.Fill.ForeColor.RGB
 
  Dim shapesArray() As String
  ReDim shapesArray(0 To Me.Shapes.Count - 1)
 
  Dim shp As Shape
  Dim cnt As Long
  For Each shp In Me.Shapes
    If shp.Name <> button.Name Then
        shapesArray(cnt) = shp.Name
        cnt = cnt + 1
    End If
  Next shp
 
  Me.Shapes.Range(shapesArray).Fill.ForeColor.RGB = RGB(175, 171, 171)
 
  button.Fill.ForeColor.RGB = RGB(0, 204, 153)
 
  Application.OnTime Now() + TimeValue("00:00:01"), "'ResetButton button, buttonColor'" 'calls function after one second has elapsed (change as desired)
    
End Sub

Lastly, let's say that your workbook is called Book1.xlsm, and that the codename (not the worksheet name) for the worksheet containing your button and shapes is called Sheet1, assign the macro to your button by right-clicking on the button, selecting Assign Macro, entering the macro name as 'Book1.xlsm'!Sheet1.Offerings1, and clicking on OK.

Hope this helps!

 

[Jasesair]

Hi Domenic, many thanks for your help. I won't pretend to fully understand what's happening in your most recent suggestions, but I'm wondering why this is a better option than your first suggestion?

 

[Domenic]

First, all of the code related to the worksheet itself is contained within the code module for the sheet. Secondly, the procedures have all been delcared as Private, so that the only way to access them is through the button. And, lastly, it avoids the use of SelectAll and Selection, which usually is not as efficient and can cause problems when the sheet is not the active sheet. Although, in this case, I don't think it would really be a problem. Nevertheless, I still like to avoid doing any selecting.

 

[Jasesair]

Thanks for that explanation. Sounds like the way to go. I managed to get this to work but now when applying this learning in a different workbook, I'm failing miserably. I keep getting a Visual Basic 400 error and can't for the life of me see where I'm going wrong.

I have the below public sub in a module:

Option Explicit

Public button As Shape
Public buttonColor As Long

Public Sub ResetButton(ByVal button As Shape, ByVal buttonColor As Long)

    button.Fill.ForeColor.RGB = buttonColor
    
End Sub

And, I have the below in the sheet module.

Private Sub Reset_Units()

    Call SetColor(Application.Caller)

End Sub
Private Sub Reset_Workbook()

    Call SetColor(Application.Caller)

End Sub

Private Sub SetColor(v)

  Dim cell As String
  cell = ActiveCell.Address
 
  Set button = Me.Shapes(v)
 
  buttonColor = button.Fill.ForeColor.RGB
 
  Dim shapesArray() As String
  ReDim shapesArray(0 To Me.Shapes.Count - 1)
 
  Dim shp As Shape
  Dim cnt As Long
  For Each shp In Me.Shapes
    If shp.Name <> button.Name Then
        shapesArray(cnt) = shp.Name
        cnt = cnt + 1
    End If
  Next shp
 
  Me.Shapes.Range(shapesArray).Fill.ForeColor.RGB = RGB(175, 171, 171)
 
  button.Fill.ForeColor.RGB = RGB(0, 204, 153)
 
  Application.OnTime Now() + TimeValue("00:00:02"), "'ResetButton button, buttonColor'"

End Sub

I have assigned the macro as you suggested.

 

[Domenic]

On which line of code does the error occur?

 

[Jasesair]

It's just one that says Visual Basic For Applications with a X warning symbol and 400.

 

[Domenic]

A few things to try...

1. Try stepping through the code one line at a time using the F8 key to see where the error occurs.
2. Try moving the code from the regular module to another regular module.
3. Try the code in a new workbook.
4. Try allowing access to the VBA project module (File > Options > Trust Center > Trust Center Settings > Macro Settings > select/check Trust access to the VBA project object module).

Does this help?

 

[Jasesair]

I hope I'm using F8 properly... it appears there is a mismatch run-time error 13 on line: buttonColor = button.Fill.ForeColor.RGB