Something like this might be what you are looking for
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub CommandButton1_Click()
Dim i As Long, txt As String, rng As Range
Set rng = Range("A1")
txt = "HELLO WORLD"
For i = 1 To Len(txt)
rng.Value = Left(txt, i)
Hey Jaafar & Neo2
I've used this in the past.
It will need editing and I don't remember who to give credit to.
Dim sTxt As String
Dim yTxt As String
Dim x As Integer, y As Integer
Dim Start, Delay
Dim myCell, myCell2
Dim Indexer As Single
Dim blnRight As Boolean
On Error Resume Next
Set myCell = Range("B2")
Set myCell2 = Range("D3")
Indexer = 50
Application.DisplayStatusBar = True
Application.StatusBar = "... Select Cell to Stop and Edit " & _
"or Wait for Flashing to Stop! "
sTxt = "Michael is in the office : " & Format$(Now, "d mmmm yyyy") & "!!!!!!!!"
yTxt = "Doing everybody else's work"
Do While Range("A1").Value <> ""
For y = 1 To 2 'Indexer Loops through the scrolling
For x = 1 To Indexer 'Index number of times
Start = Timer 'Set start to internal timer
Delay = Start + 0.02 'Set delay for .15 secs
Do While Timer < Delay 'Do the display routine
If blnRight Then 'have u reached the right hand side
[D2] = Space(Indexer - x) & sTxt
[D3] = Space(x) & yTxt 'Show 1 str @ a time
[D2] = Space(x) & sTxt
[D3] = Space(Indexer - x) & yTxt 'Show 1 str @ a time
Loop 'Loop until delay is up
Start = Timer 'and reset the timer
Delay = Start + 0.02 'and the delay
If x = Indexer Then blnRight = Not (blnRight) 'True or false
Next x 'Show the next str
Loop 'Do this again
[D2] = "" 'Reset
[D3] = ""
Application.StatusBar = False
Application.DisplayStatusBar = Application.DisplayStatusBar
I am familiar with similar algorithms but one of the main problems with this is that the text overlaps adjacent cells and It is difficult to figure out the exact position of the last Character based on the Cell width.
In order to achieve the Stock Tickers effect, the characters need to disappear one by one when reaching the width of the cell as they are being pushed
Had another look at this, not thought of using Timer and DoEvents until I had a closer look at Michaels code.
In a standard module
Application.Calculation = xlCalculationManual
Dim tMsg As String, tCell As Range, tLen As Long, tPos As Long
Dim Start, Delay
Set tCell = Range("A1")
tMsg = "This is a test message!"
.Name = "Courier New"
.FontStyle = "Regular"
.Size = 10
tCell.ColumnWidth = Round(tCell.ColumnWidth, 0)
tLen = tCell.ColumnWidth - 1
Start = Timer
If tPos > Len(tMsg) Then
tPos = 1
Delay = Timer + 1
tPos = tPos + 1
Delay = Timer + 0.2
Do While Timer < Delay
tCell.Value = Mid(tMsg, tPos, tLen)
Assuming DoEvents kills the code instantly when interupted I've used a change event in the worksheet module where the ticker is located to re-enable calculation.
Sub worksheet_change(ByVal target As Range)
Application.Calculation = xlCalculationAutomatic
Finally in the workbook module to kick off when the file is opened, short and simple
Private Sub Workbook_Open()
The only thing I'm unsure of now is restarting the ticker after it's been interupted, given the way code is executed in excel I don't think a continuous scroll effect is possible without using a formula / force recalc method, which I thought after suggesting before, could, if the workbook is formula heavy, be asking for disaster.