Scrolling Text

neo2

New Member
Joined
Jul 22, 2010
Messages
33
Is it possible to get scrolling text like a marquee effect in excel ?
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

gauntletxg

Well-known Member
Joined
Jul 15, 2008
Messages
636
Something like this might be what you are looking for

Code:
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)
    Sleep 50
Next
End Sub
 

neo2

New Member
Joined
Jul 22, 2010
Messages
33
this does not do what I'm looking for. I want the text to move across the cell, like what you see on the stock tickers on tv.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,118
Office Version
  1. 2016
Platform
  1. Windows
Just bumping this thread to see if somoeone knows of an easy way of doing this . Unless I am missing something, achieving this scrolling effect (stock tickers) is not as easy as it first appears.

I have a workaround in mind but it is rather involved . Maybe I am missing an easier solution..
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,763
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

Hey Jaafar & Neo2
I've used this in the past.
It will need editing and I don't remember who to give credit to.
Code:
Sub Macro1()
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 <> ""
   DoEvents
   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
            Else
               [D2] = Space(x) & sTxt
               [D3] = Space(Indexer - x) & yTxt    'Show 1 str @ a time
            End If
            DoEvents
         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
Next y
Loop                                                'Do this again
[D2] = ""                                           'Reset
[D3] = ""

 
JACK:
Application.StatusBar = False
Application.DisplayStatusBar = Application.DisplayStatusBar
 
End Sub
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,118
Office Version
  1. 2016
Platform
  1. Windows
Thanks Michael.

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
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,971
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

An crude, ugly and slow scrolling method, but it cures the overlap problem.

A1 holds original text, A2 holds this formula to produce the marquee effect, combined with an event timer to force excel recalc at 1 sec intervals.

=MID(A1&REPT(" ",CELL("Width",A2)),MIN(1,MOD(SECOND(NOW()),(LEN(A1&REPT(" ",CELL("Width",A2)))))),CELL("Width",A2))

Maybe combining this theory with Michaels code will provide an ideal solution.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,118
Office Version
  1. 2016
Platform
  1. Windows
Thanks jasonb75. Nice use of the Cell("Width",...) Function ! - It does almost cure the overlap problem.

Close but not exactly the desired visual effect. I have played with your formula based solution and combined it with Michael's code and other similar codes but none of them yield the desired result.

I am just putting the last touches on the code I have written which is as close as I could get . I'll post it shortly.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,971
Office Version
  1. 365
Platform
  1. Windows
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
Code:
Sub Ticker()
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!"
With tCell.Font
        .Name = "Courier New"
        .FontStyle = "Regular"
        .Size = 10
End With
    tCell.ColumnWidth = Round(tCell.ColumnWidth, 0)
    tLen = tCell.ColumnWidth - 1
Do
    Start = Timer
If tPos > Len(tMsg) Then
    tPos = 1
Delay = Timer + 1
Else
    tPos = tPos + 1
Delay = Timer + 0.2
End If
    Do While Timer < Delay
        DoEvents
        tCell.Value = Mid(tMsg, tPos, tLen)
    Loop
Loop
End Sub

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.

Code:
Sub worksheet_change(ByVal target As Range)
Application.Calculation = xlCalculationAutomatic
End Sub

Finally in the workbook module to kick off when the file is opened, short and simple

Code:
Private Sub Workbook_Open()
Ticker
End Sub

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.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,118
Office Version
  1. 2016
Platform
  1. Windows
Thanks Jasonb75 for your help with this.

Unfortunatly having a constant recalculation like you said is not a practical solution. Also, the visual effect is still not the Stock Ticker one.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,125
Messages
5,599,841
Members
414,342
Latest member
K Darrell Smith

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
Top