# LED Display Anyone?



## MrIfOnly (May 13, 2017)

Anyone looking for a LED display in Excel?

So, I've been bored the past couple of days and started tinkering around with this.  I thought it was kind of cool and figured I'd share.  I really don't have any application for it, so if you do use it, please satisfy my curiosity by posting your use for it.

It looks like this:






Imgur: The most awesome images on the Internet

The code for creating the number shape (note the note noted in red ) on a new sheet that you can copy and paste into your working worksheet (paste code into standard module and run as many times as needed):


```
Sub newNumber()
Dim startX As Integer, startY As Integer, i As Integer
Dim WSNew As Worksheet
i = 1 [COLOR=#ff0000]'set as increment number for each new digit[/COLOR]
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Set WSNew = ActiveWorkbook.ActiveSheet
'TOP1
startX = 500
startY = 100
With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY + 5
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 40, startY + 15
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 10, startY + 15
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 5
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
    .ConvertToShape
End With
With WSNew.Shapes(1)
    .Name = "TOP" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'MIDDLE1
startX = startX - 3
startY = startY + 74
With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX + 4, startY - 1)
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 12, startY - 9
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 44, startY - 9
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 52, startY - 1
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 52, startY + 1
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 44, startY + 9
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 12, startY + 9
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 4, startY + 1
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 4, startY - 1
    .ConvertToShape
End With
With WSNew.Shapes(2)
    .Name = "MIDDLE" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'BOTTOM1
startX = startX + 3
startY = startY + 59
With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY + 5
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 40, startY + 15
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 10, startY + 15
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 5
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
    .ConvertToShape
End With
With WSNew.Shapes(3)
    .Flip msoFlipVertical
    .Name = "BOTTOM" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'LEFTTOP1
startX = 494
startY = 106
With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
    .ConvertToShape
End With
With WSNew.Shapes(4)
    .Name = "LEFTTOP" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'LEFTBOTTOM1
startX = 494
startY = 175
With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
    .ConvertToShape
End With
With WSNew.Shapes(5)
    .Name = "LEFTBOTTOM" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'RIGHTTOP1
startX = 541
startY = 106
With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
    .ConvertToShape
End With
With WSNew.Shapes(6)
    .Flip msoFlipHorizontal
    .Name = "RIGHTTOP" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
'RIGHTBOTTOM1
startX = 541
startY = 175
With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
    .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
    .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
    .ConvertToShape
End With
With WSNew.Shapes(7)
    .Flip msoFlipHorizontal
    .Name = "RIGHTBOTTOM" & i
    .Line.Transparency = 1
    With .Fill
        .Solid
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End With
End Sub
```

The code for the commandbuttons (paste into worksheet module):


```
Option Explicit
Dim stopTimer As Boolean
Dim n As Integer

Private Sub OnBtn_Click()
    For n = 1 To 3
        NumberON m:=8, n:=n
        Shapes("POINT").Fill.Transparency = 0
    Next n
End Sub
Private Sub OffBtn_Click()
    For n = 1 To 3
        NumberOFF n:=n
        Shapes("POINT").Fill.Transparency = 0.9
    Next n
End Sub
Private Sub StartBtn_Click()
Dim Start
Dim msec As Integer, sec As Integer, sec2 As Integer
    stopTimer = False
    
    Shapes("POINT").Fill.Transparency = 0
    For n = 1 To 3
        NumberON m:=0, n:=n
    Next n
    
    Start = Timer    ' Set start time.
    
    Do While Timer < Start + 100 'set this number to limit the time the clock will run
        DoEvents    ' Yield to other processes.
        If stopTimer = True Then Exit Do
        msec = ((Timer * 10) Mod (Start * 10))
        If msec = 10 Then
            sec = sec + 1
            If sec = 10 Then
                sec2 = sec2 + 1
                If sec2 = 10 Then Exit Sub
                NumberON m:=sec2, n:=3
                sec = 0
            End If
            Start = Timer
            With Shapes("POINT").Glow
                .Color = RGB(255, 0, 0)
                .Radius = IIf(.Radius = 0, 5, 0)
                .Transparency = 0.5
            End With
            NumberON m:=sec, n:=2
            msec = 0
        End If
        NumberON m:=msec, n:=1
    Loop
    
    With Shapes("POINT").Glow
        .Color = RGB(255, 0, 0)
        .Radius = IIf(.Radius = 0, 5, 0)
        .Transparency = 1
    End With
End Sub
Private Sub StopBtn_Click()
    stopTimer = True
End Sub
```

Spinbutton option if you want it (again, paste into worksheet module):


```
Private Sub SpinButton1_Change()
    If SpinButton1.Value > 9 Then SpinButton1.Value = 0
    If SpinButton1.Value < 0 Then SpinButton1.Value = 9
    NumberON m:=SpinButton1.Value, n:=1
End Sub
```

And, finally, the code to run the numbers (paste into standard module):


```
Option Explicit
Dim Number As Object, shape8 As Object

Public Sub NumberOFF(n As Integer)
Set shape8 = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, _
    "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
With shape8.Fill
    .Solid
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0.9
End With
With shape8.Glow
    .Color = RGB(255, 0, 0)
    .Radius = IIf(.Radius = 0, 0, 0)
    .Transparency = 1
End With
End Sub
Sub NumberON(m As Integer, n As Integer)
NumberOFF n:=n
    Select Case m
        Case 1
        Set Number = ActiveSheet.Shapes.Range(Array("RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 2
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n))
        Case 3
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 4
        Set Number = ActiveSheet.Shapes.Range(Array("MIDDLE" & n, "LEFTTOP" & n, "RIGHTBOTTOM" & n, "RIGHTTOP" & n))
        Case 5
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "RIGHTBOTTOM" & n))
        Case 6
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTBOTTOM" & n))
        Case 7
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 8
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 9
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "MIDDLE" & n, "LEFTTOP" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 0
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
    End Select
With Number.Fill
    .Solid
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
End With
With Number.Glow
    .Color = 2238442
    .Radius = IIf(.Radius = 0, 2, 0)
    .Transparency = 0.8
End With
End Sub
```

Regards,
 CJ


----------



## My Aswer Is This (May 14, 2017)

Wow. Looks like you did a lot of work here.


----------



## MrIfOnly (May 14, 2017)

Just a lot of time on my hands at work the past couple of days.  As Albert Speer said in his prison memoirs: "The one circle of hell that Dante forgot was ennui."


----------



## kelly mort (May 14, 2017)

I will copy it and use it for my project. Will get u posted when i am true. 

By the way can i show it on a userform????


----------



## MrIfOnly (May 14, 2017)

As it is, no.  When I get a chance I'll try to adapt it to work on userforms.


----------



## kelly mort (May 14, 2017)

Okay thanks


----------



## kelly mort (May 14, 2017)

Do i have to paste all worksheet module codes into one sheet module or different modules???


----------



## MrIfOnly (May 14, 2017)

Paste the code for the commandbuttons and/or spinbutton into the module for the sheet on which they (and the number layout) reside.


----------



## kelly mort (May 14, 2017)

so how many sheets do i need?


----------



## My Aswer Is This (May 14, 2017)

Does this script install all the Buttons?
It appears as if there are:

 One Spin Button
Two Command Buttons
Two Option Buttons

These look like Form Controls: True ?


----------



## kelly mort (May 14, 2017)

When i pasted and ran the code only the 8 appeared. Maybe i did something wrongly


----------



## MrIfOnly (May 14, 2017)

My Aswer Is This said:


> Does this script install all the Buttons?
> It appears as if there are:
> 
> One Spin Button
> ...



The script does not install the buttons.  They are all ActiveX controls.  I used 4 command buttons (StartBtn, StopBtn, On & Off.  Although, now that you mention it, option buttons would have been better for the On and Off.


----------



## My Aswer Is This (May 14, 2017)

Thanks.

When I make a Activex Spin button it does not look like yours.

Now if I make a Form Control Spin Button it looks like yours.
Using Excel 2013


----------



## MrIfOnly (May 14, 2017)

kelly mort said:


> When i pasted and ran the code only the 8 appeared. Maybe i did something wrongly



You did it correctly.  Now add at least 2 command buttons, "StartBtn" & "StopBtn".  If you run the "newNumber" macro again, change the increment number each time you re-run it:


```
i = 2 'set as increment number for each new digit
```

It will create new numbers on new sheets.  Select the shapes, right click, select group, then copy & paste the new numbers into the original sheet with the command buttons.

The code is currently setup for 3 digits and a rectangle shape called "POINT" (you'll have to draw this in yourself if you want it).

Sorry I didn't make this more plug n' play.  To make it simpler, here is the code for just running a single digit with no point and only the Start and Stop buttons:


```
Option Explicit
Dim stopTimer As Boolean
Dim n As Integer


Private Sub StartBtn_Click()
Dim Start
Dim msec As Integer, sec As Integer, sec2 As Integer
    stopTimer = False
    
    For n = 1 To 1
        NumberON m:=0, n:=n
    Next n
    
    Start = Timer    ' Set start time.
    
    Do While Timer < Start + 100 'set this number to limit the time the clock will run
        DoEvents    ' Yield to other processes.
        If stopTimer = True Then Exit Do
        msec = ((Timer * 10) Mod (Start * 10))
        If msec = 10 Then
            Start = Timer
            msec = 0
        End If
        NumberON m:=msec, n:=1
    Loop
End Sub
Private Sub StopBtn_Click()
    stopTimer = True
End Sub
```

CJ


----------



## kelly mort (May 14, 2017)

MrIfOnly said:


> You did it correctly.  Now add at least 2 command buttons, "StartBtn" & "StopBtn"...
> 
> CJ



Okay


----------



## MrIfOnly (May 14, 2017)

You can also PM your e-mail address and I can send the file to you if you'd like.


----------



## kelly mort (May 16, 2017)

Hello MrIfOnly, 
I ran the LED DISPLAY you sent me and i really liked it. But the timer can it run till i stop it? Because it stops after sometime then i have to start it again. 

Thanks and regards.


----------



## MrIfOnly (May 16, 2017)

kelly mort said:


> Hello MrIfOnly,
> I ran the LED DISPLAY you sent me and i really liked it. But the timer can it run till i stop it? Because it stops after sometime then i have to start it again.
> 
> Thanks and regards.



Hi Kelly,

Yes, it is currently programmed to run up to 99.9 seconds, but you can modify the code as follows to allow for continuous running:

Replace:


```
If sec2 = 10 Then Exit Sub
```

in the StartBtn click event code with:


```
If sec2 = 10 Then
                    msec = 0
                    sec = 0
                    sec2 = 0
                End If
```

Regards,

CJ


----------



## kelly mort (May 16, 2017)

Okay thanks. I want to get it to my project so that it will start running whenever i open my workbook.


----------



## MrIfOnly (May 17, 2017)

kelly mort said:


> Okay thanks. I want to get it to my project so that it will start running whenever i open my workbook.




Kelly,

In order to do this, follow the steps below:

1) Delete this line from the worksheet module:

```
Dim stopTimer As Boolean
```

2) Add this line to your declarations at the top of your standard module:

```
Public stopTimer As Boolean
```

3) Paste this code to your ThisWorkbook  module (this assumes you still have the sheet named "Counter" with the digits on it):

```
Private Sub Workbook_Open()
    Application.WindowState = xlMaximized
    
Dim Start
Dim msec As Integer, sec As Integer, sec2 As Integer, n As Integer
    stopTimer = False
With Worksheets("Counter")
    .Activate
    .Shapes("POINT").Fill.Transparency = 0
    For n = 1 To 3 'set this to the number of digits
        NumberON m:=0, n:=n
    Next n
DoEvents
    Start = Timer    ' Set start time.
    Do While Timer < Start + 100 'set this number to limit the time the clock will run
        DoEvents    ' Yield to other processes.
        If stopTimer = True Then Exit Do
        msec = ((Timer * 10) Mod (Start * 10))
        If msec = 10 Then
            sec = sec + 1
            If sec = 10 Then
                sec2 = sec2 + 1
                If sec2 = 10 Then
                    msec = 0
                    sec = 0
                    sec2 = 0
                End If
                NumberON m:=sec2, n:=3
                sec = 0
            End If
            Start = Timer
            With .Shapes("POINT").Glow
                .Color = RGB(255, 0, 0)
                .Radius = IIf(.Radius = 0, 5, 0)
                .Transparency = 0.5
            End With
            NumberON m:=sec, n:=2
            msec = 0
        End If
        NumberON m:=msec, n:=1
    Loop
    With .Shapes("POINT").Glow
        .Color = RGB(255, 0, 0)
        .Radius = IIf(.Radius = 0, 5, 0)
        .Transparency = 1
    End With
End With
End Sub
```

Regards,

CJ


----------



## kelly mort (May 18, 2017)

MrIfOnly said:


> Hi Kelly,
> 
> Yes, it is currently programmed to run up to 99.9 seconds, but you can modify the code as follows to allow for continuous running:
> 
> ...



Still it stops after sometime of running. I ran it first for 27 seconds then stops and again 37 seconds then stops


----------



## kelly mort (May 18, 2017)

Then it stops again after 54 seconds


----------



## MrIfOnly (May 19, 2017)

Kelly,

I haven't been able to duplicate your problem.  Does the counter stop at those numbers consistently?  Are you performing any other actions when it stops?  Are you running any other workbooks?

Stay tuned...new and improved code to come.  Maybe it will fix your issues.

CJ


----------



## MrIfOnly (May 19, 2017)

*LED Display *NEW & IMPROVED!**

*NEW & IMPROVED!*

Now with 30% less hassle!

Added LCD display option.  See picture below:







The following code (pasted into and run from a standard module) will generate everything for you in a new worksheet with the option of setting the number of digits via an input box at runtime.


```
Option Explicit
Dim startX As Integer, startY As Integer, i As Integer, j As Integer, digitCnt As String
Dim WSNew As Worksheet
Const InitialstartX As Integer = 600, InitialstartY As Integer = 100
Sub NEWNUMBER()
Do 'input for number of digits
    digitCnt = InputBox("Enter number of digits to be generated.", Default:=3)
    If digitCnt = "" Then Exit Sub
    digitCnt = CInt(digitCnt)
Loop Until digitCnt > 0 And digitCnt < 8
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Set WSNew = ActiveWorkbook.ActiveSheet
ActiveWindow.DisplayGridlines = False
startX = InitialstartX
startY = InitialstartY
j = 1
For i = 1 To digitCnt 'total number of digits
    If i = 2 Then 'POINT
        With WSNew.Shapes.AddShape(msoShapeRectangle, InitialstartX - 23, InitialstartY + 138, 12, 12)
            .Name = "POINT"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        j = j + 1
    End If
    If i = 4 Then 'Minutes Separator
        With WSNew.Shapes.AddShape(msoShapeRectangle, startX + 60, InitialstartY + 110, 12, 12)
            .Name = "TOPSEP1"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        With WSNew.Shapes.AddShape(msoShapeRectangle, startX + 60, InitialstartY + 40, 12, 12)
            .Name = "BTMSEP1"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        j = j + 2
    End If
    If i = 6 Then 'Hours Separator
        With WSNew.Shapes.AddShape(msoShapeRectangle, startX + 60, InitialstartY + 110, 12, 12)
            .Name = "TOPSEP2"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        With WSNew.Shapes.AddShape(msoShapeRectangle, startX + 60, InitialstartY + 40, 12, 12)
            .Name = "BTMSEP2"
            .Fill.ForeColor.RGB = vbRed
            .Line.Transparency = 1
            .Placement = 3
        End With
        j = j + 2
    End If
'TOP1
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY + 5
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 40, startY + 15
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 10, startY + 15
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 5
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Name = "TOP" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'MIDDLE1
    startX = startX - 3
    startY = startY + 74
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX + 4, startY - 1)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 12, startY - 9
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 44, startY - 9
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 52, startY - 1
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 52, startY + 1
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 44, startY + 9
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 12, startY + 9
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 4, startY + 1
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 4, startY - 1
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Name = "MIDDLE" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'BOTTOM1
    startX = startX + 3
    startY = startY + 59
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 50, startY + 5
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 40, startY + 15
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 10, startY + 15
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 5
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Flip msoFlipVertical
        .Name = "BOTTOM" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'LEFTTOP1
    startX = startX - 6
    startY = startY - 127
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Name = "LEFTTOP" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'LEFTBOTTOM1
    startX = startX
    startY = startY + 69
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Name = "LEFTBOTTOM" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'RIGHTTOP1
    startX = startX + 47
    startY = startY - 69
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Flip msoFlipHorizontal
        .Name = "RIGHTTOP" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
'RIGHTBOTTOM1
    startX = startX
    startY = startY + 69
    With WSNew.Shapes.BuildFreeform(msoEditingCorner, startX, startY)
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 10
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 15, startY + 57
        .AddNodes msoSegmentLine, msoEditingAuto, startX + 5, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY + 67
        .AddNodes msoSegmentLine, msoEditingAuto, startX, startY
        .ConvertToShape
    End With
    With WSNew.Shapes(j)
        .Flip msoFlipHorizontal
        .Name = "RIGHTBOTTOM" & i
        .Line.Transparency = 1
        .Placement = 3
        With .Fill
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    j = j + 1
    startX = startX - 125
    startY = InitialstartY
Next i
'COMMAND & OPTION BUTTONS
    With ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, InitialstartX + 80, InitialstartY, 120, 30)
        .ShapeStyle = msoShapeStylePreset25
        .OnAction = "runTimer"
        .Name = "StartBtn"
        .Title = digitCnt
        With .TextFrame2
            .TextRange.Characters.Text = "START"
            .TextRange.Characters.Font.Size = 16
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter
        End With
    End With
    With ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, InitialstartX + 80, InitialstartY + 60, 120, 30)
        .ShapeStyle = msoShapeStylePreset24
        .OnAction = "stpTimer"
        With .TextFrame2
            .TextRange.Characters.Text = "STOP"
            .TextRange.Characters.Font.Size = 16
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter
        End With
    End With
WSNew.OLEObjects.Add ClassType:="Forms.OptionButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=InitialstartX + 100, Top:=InitialstartY + 110, _
    Width:=120, Height:=30
    
WSNew.OLEObjects.Add ClassType:="Forms.OptionButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=InitialstartX + 150, Top:=InitialstartY + 110, _
    Width:=120, Height:=30
    
    With ActiveSheet.OLEObjects("OptionButton1")
        .Name = "LEDOpt"
        .Object.AutoSize = True
        .Object.Caption = "LED"
        .Object.Value = True
    End With
    
    With ActiveSheet.OLEObjects("OptionButton2")
        .Name = "LCDOpt"
        .Object.AutoSize = True
        .Object.Caption = "LCD"
        .Object.Value = False
    End With
End Sub
```

The following code (pasted into a new standard module) will run the counter, automatically adjusting for the number of digits.  It will loop back to zero after a total of 24 hours.  I tested it up to one hour so more testing is needed though.


```
Option Explicit
Dim Start
Dim msec As Integer, sec As Integer, sec2 As Integer, min As Integer, min2 As Integer
Dim hr As Integer, hr2 As Integer, n As Integer, digitCnt As Integer
Dim Number As Object
Public setColor As String
Public stopTimer As Boolean
Public Sub runTimer()
digitCnt = ActiveSheet.Shapes("StartBtn").Title
stopTimer = False
sec = 0
sec2 = 0
min = 0
min2 = 0
hr = 0
hr2 = 0
If digitCnt > 1 Then PointON
If digitCnt > 3 Then SEP1ON
If digitCnt > 5 Then SEP2ON
    For n = 1 To digitCnt 'number of digits
        NumberON m:=0, n:=n
    Next n
 
Start = Timer    'Set start time.
    
    Do While Timer < Start + 100
        DoEvents    ' Yield to other processes.
        If stopTimer = True Then Exit Do
        msec = ((Timer * 10) Mod (Start * 10))
        If digitCnt > 1 And msec = 5 Then PointOFF
        
        If msec = 10 Then '
            If digitCnt > 1 Then ''
                sec = sec + 1
                PointON
                If sec = 10 Then '
                    If digitCnt > 2 Then ''
                        sec2 = sec2 + 1
                        If sec2 = 6 Then '
                            If digitCnt > 3 Then ''
                                min = min + 1
                                If min = 10 Then '
                                    If digitCnt > 4 Then ''
                                        min2 = min2 + 1
                                        If min2 = 6 Then '
                                            If digitCnt > 5 Then ''
                                                hr = hr + 1
                                                If hr = 10 Then '
                                                    If digitCnt > 6 Then ''
                                                        hr2 = hr2 + 1
                                                        If hr2 = 2 And hr = 4 Then '
                                                            hr2 = 0
                                                            hr = 0
                                                        End If '
                                                    NumberON m:=hr2, n:=7
                                                    End If ''
                                                hr = 0
                                                End If '
                                            NumberON m:=hr, n:=6
                                            End If ''
                                        min2 = 0
                                        End If '
                                    NumberON m:=min2, n:=5
                                    End If ''
                                min = 0
                                End If '
                            NumberON m:=min, n:=4
                            End If ''
                        sec2 = 0
                        End If '
                    NumberON m:=sec2, n:=3
                    End If ''
                sec = 0
                End If '
            NumberON m:=sec, n:=2
            End If ''
        Start = Timer
        msec = 0
        End If '
        NumberON m:=msec, n:=1
    Loop
If digitCnt > 1 Then PointON
End Sub
Public Sub stpTimer()
    stopTimer = True
End Sub
Public Sub PointOFF()
    With ActiveSheet.Shapes("POINT").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0.9
    End With
End Sub
Public Sub PointON()
If ActiveSheet.LEDOpt.Value = True Then setColor = vbRed
If ActiveSheet.LEDOpt.Value = False Then setColor = vbBlack
    With ActiveSheet.Shapes("POINT").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
End Sub
Public Sub SEP1ON() 'Minutes Separator
If ActiveSheet.LEDOpt.Value = True Then setColor = vbRed
If ActiveSheet.LEDOpt.Value = False Then setColor = vbBlack
    With ActiveSheet.Shapes("TOPSEP1").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
    With ActiveSheet.Shapes("BTMSEP1").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
End Sub
Public Sub SEP2ON() 'Hour Separator
If ActiveSheet.LEDOpt.Value = True Then setColor = vbRed
If ActiveSheet.LEDOpt.Value = False Then setColor = vbBlack
    With ActiveSheet.Shapes("TOPSEP2").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
    With ActiveSheet.Shapes("BTMSEP2").Fill
        .ForeColor.RGB = setColor
        .Transparency = 0
    End With
End Sub
Public Sub NumberOFF(n As Integer)
If ActiveSheet.LEDOpt.Value = True Then setColor = vbRed
If ActiveSheet.LEDOpt.Value = False Then setColor = vbBlack
Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, _
    "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
With Number.Fill
    .Solid
    .ForeColor.RGB = setColor
    .Transparency = 0.9
End With
With Number.Glow
    .Color = setColor
    .Radius = IIf(.Radius = 0, 0, 0)
    .Transparency = 1
End With
End Sub
Sub NumberON(m As Integer, n As Integer)
NumberOFF n:=n
    Select Case m
        Case 1
        Set Number = ActiveSheet.Shapes.Range(Array("RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 2
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n))
        Case 3
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 4
        Set Number = ActiveSheet.Shapes.Range(Array("MIDDLE" & n, "LEFTTOP" & n, "RIGHTBOTTOM" & n, "RIGHTTOP" & n))
        Case 5
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "RIGHTBOTTOM" & n))
        Case 6
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTBOTTOM" & n))
        Case 7
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 8
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "MIDDLE" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 9
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "MIDDLE" & n, "LEFTTOP" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
        Case 0
        Set Number = ActiveSheet.Shapes.Range(Array("TOP" & n, "BOTTOM" & n, "LEFTTOP" & n, "LEFTBOTTOM" & n, "RIGHTTOP" & n, "RIGHTBOTTOM" & n))
    End Select
With Number.Fill
    .Solid
    .ForeColor.RGB = setColor
    .Transparency = 0
End With
End Sub
```

Regards,

CJ


----------



## kelly mort (May 19, 2017)

Wow!!!! You are really doing a hard work!!!!. Can you send this one to me, please??
Kelly


----------



## kelly mort (May 19, 2017)

I really like this LED and LCD display. But on my pc it always stops after sometime. When i ran this one first it took 1 minute 40 seconds then stops. I ran it again and had 1 min 49 seconds


----------



## MrIfOnly (May 19, 2017)

I still can't duplicate this.  I ran this on 2 different machines: WinXP running Excel 2010 and Win10 running Excel 2016.  My laptop uses an AMD processor and I have noticed an intermittent lag when I move my mouse, but no stoppage.  I was able to select cells in the sheet and move around using my arrow keys.  The only time the counter stopped is when I typed something or clicked on a button in the ribbon.  In fact, I was even able to play a rousing game of minesweeper while the counter continued to run.

CJ


----------



## kelly mort (May 20, 2017)

Okay i will try and ran it on a different machine and see. Thanks and nice work. The LCD is super cool.


----------

