Need help changing cell color in a macro

S

SoldierofJustice

New Member
Joined
Dec 1, 2012
Messages
2
Hello all,

I needed to create a stopwatch in Excel. I found one on these forums located here: http://www.mrexcel.com/forum/excel-questions/534628-create-stopwatch-excel-2.html

It did almost everything I needed, however I wanted the cells to change color to yellow when the timer hit 30 seconds and red when it hit zero. I tried playing around with the code, but now the cells change color every time C1 hits 30 seconds (i.e. 2:30, 1:30.) The code is as follows:

Code: 
Dim alarm As Date


Sub initialize()
' set default values
    Range("B1:B2").MergeCells = True
    Range("C1:C2").MergeCells = True
    Range("B1:C2").Select


    With Selection

        ' Borders
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous

        ' Text Alignment
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter

        ' Font
        .Font.Name = "Calibri"
        .Font.Size = 28
    End With

    Rows("1:2").RowHeight = 40
    Rows("1,3").ColumnWidth = 20


    'Add Start Button
    ActiveSheet.Range("A1").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
    With Selection
        .Characters.Text = "Start"
        .OnAction = "StartTimer"
        .Font.Name = "Calibri"
        .Font.Size = 22
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    'Add Stop Button
    ActiveSheet.Range("A2").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
    With Selection
        .Characters.Text = "Stop"
        .OnAction = "StopTimer"
        .Font.Name = "Calibri"
        .Font.Size = 22
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    ActiveSheet.Range("B1").Value = 0
    ActiveSheet.Range("C1").Value = 0

Call StartTimer

End Sub

Sub StartTimer()
'start timer, set values according to value on sheet

    Call TrapTime

End Sub
Private Sub UpdateDisplay()
' updates display

    ActiveSheet.Range("C1").Value = ActiveSheet.Range("C1").Value - 1

        If ActiveSheet.Range("C1").Value < 0 Then
            ActiveSheet.Range("B1").Value = ActiveSheet.Range("B1").Value - 1
            ActiveSheet.Range("C1").Value = ActiveSheet.Range("C1").Value + 60
            If ActiveSheet.Range("B1").Value > 0 Then
                Range("B1:C2").Interior.Color = 4
            ElseIf ActiveSheet.Range("B1").Value = 0 And ActiveSheet.Range("C1") <= 30 Then
                Range("B1:C2").Interior.Color = 6
            ElseIf ActiveSheet.Range("B1").Value = 0 And ActiveSheet.Range("C1") = 0 Then
                Range("B1:C2").Interoir.Color = 3
            End If
        End If


Call TrapTime

End Sub
Private Sub TrapTime()

    If ActiveSheet.Range("B1").Value = 0 And ActiveSheet.Range("C1").Value = 0 Then
        StopTimer
        Exit Sub
    End If

    alarm = CDate(Date) + TimeValue(Now()) + TimeValue("00:00:01")
    Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay"

End Sub
Sub StopTimer()

    On Error Resume Next
    Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay", schedule:=False

End Sub

I placed the color changing code in UpdateDisplay.


It has been over a decade since I did any programming, so I am really fumbling through this. Any help you all can give would be greatly appreciated.

Thank you.
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
A couple of problems were:
  • There was a Typo on "interior",
  • you needed .colorindex, not .color,
  • the IFs were embedded and so not getting the right conditions.
Try the code below. I've also added the macro assignation to the shape on initialize.

ps: as a general rule avoid merged cells when intending to use VBA; it can trip you up.
Code: 
Dim alarm As Date


Sub initialize()
' set default values
    Range("B1:B2").MergeCells = True
    Range("C1:C2").MergeCells = True
    Range("B1:C2").Select


    With Selection

        ' Borders
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous

        ' Text Alignment
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter

        ' Font
        .Font.Name = "Calibri"
        .Font.Size = 28
    End With

    Rows("1:2").RowHeight = 40
    Rows("1,3").ColumnWidth = 20


    'Add Start Button
    ActiveSheet.Range("A1").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
    With Selection
        .Characters.Text = "Start"
        .OnAction = "StartTimer"
        .Font.Name = "Calibri"
        .Font.Size = 22
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .OnAction = "'" & ActiveWorkbook.Name & "'!StartTimer"
    End With

    'Add Stop Button
    ActiveSheet.Range("A2").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
    With Selection
        .Characters.Text = "Stop"
        .OnAction = "StopTimer"
        .Font.Name = "Calibri"
        .Font.Size = 22
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .OnAction = "'" & ActiveWorkbook.Name & "'!StopTimer"
    End With

    ActiveSheet.Range("B1").Value = 0
    ActiveSheet.Range("C1").Value = 0

Call StartTimer

End Sub

Sub StartTimer()
'start timer, set values according to value on sheet

    Call TrapTime

End Sub
Private Sub UpdateDisplay()
' updates display

    ActiveSheet.Range("C1").Value = ActiveSheet.Range("C1").Value - 1
    Debug.Print Range("B1").Value, Range("C1").Value
    
    If ActiveSheet.Range("C1").Value < 0 Then
        ActiveSheet.Range("B1").Value = ActiveSheet.Range("B1").Value - 1
        ActiveSheet.Range("C1").Value = ActiveSheet.Range("C1").Value + 60
        
    End If
    If ActiveSheet.Range("B1").Value > 0 Or ActiveSheet.Range("C1") >= 30 Then
        Range("B1:C1").Interior.ColorIndex = 4 'changed to colorindex
    ElseIf ActiveSheet.Range("B1").Value = 0 And ActiveSheet.Range("C1") <= 30 Then
        Range("B1:C1").Interior.ColorIndex = 6
    End If
    If ActiveSheet.Range("B1").Value = 0 And ActiveSheet.Range("C1") = 0 Then
        Debug.Print "Got it"
        Range("B1:C1").Interior.ColorIndex = 3 'typo on interior
    End If

Call TrapTime

End Sub
Private Sub TrapTime()

    If ActiveSheet.Range("B1").Value = 0 And ActiveSheet.Range("C1").Value = 0 Then
        StopTimer
        Exit Sub
    End If

    alarm = CDate(Date) + TimeValue(Now()) + TimeValue("00:00:01")
    Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay"

End Sub
Sub StopTimer()

    On Error Resume Next
    Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay", schedule:=False

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Adding Sort To Current Code
2
Replies
14
Views
247
Pacman52
P
K
  • Solved
formating question
Replies
3
Views
324
Micron
M
K
  • Question Question
VBA DOUBT- can we add heading color and remove blank columns in this code?
Replies
0
Views
168
Kishore1982
K
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
594
RoryA
RoryA
H
  • Question Question
Save and Close Excel after a 15min inactivity.
Replies
4
Views
779
Hopey87
H

Forum statistics

Threads
1,224,616
Messages
6,179,909
Members
452,949
Latest member
beartooth91

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