Excel Animated Headline Bar & Shapes

on

As the data is getting bigger so is the need to concise and present it in an easily meaningful fashion. We have looked at different data visualization techniques recently. One of my friends recently asked me to add on a moving headline bar on top of a data presentation spreadsheet and after pondering a little, it worked.

Actually creating a headline of key figures shall convey the meaning in more concise manner than any other way possible. Before I jump ahead to explain the above Dashboard type visualization and headline bar, just to clarify that here purpose is to present the data visualization and analytical technique. In any way, it doesn't cover any sort of financial or accounting aspect of Reporting. Making a financial model on any aspect of Accountancy profession is a different topic although we can use such analytical or visualization tool to have better modelling. If you are interested in Financial Modelling, then don't wait and subscribe to the blog, as soon we shall publish posts on it.

Coming back to this Dashboard and animated headline bar. I have used the VB code to give an animated affect to the top bar.


Step No. 1

To get the headline bar, insert four shapes by going to Insert>Shapes. Add the key reporting text which you want to report on them.

Step No.2

Create multiple replicas of these shapes and place them horizontally.

Step no.3

Go to VB window and add the below VB code in a module. Here i assume that you know the fundamentals of VB programming.

VB Code:

Sub Countdown()

Repeat:

Range("A2").Value = 0
     
        Dim CurrentTime
        Dim i As Integer
        Dim j As Integer
     
        j = Range("A1").Value
         
         
            For i = 1 To j
             
                CurrentTime = Timer
             
                Do While Timer < CurrentTime + 0.5
             
                    DoEvents
         
                Loop
             
             
                Range("A2").Value = i
             
             
            Next i

GoTo Repeat

     End Sub
----------

My worksheet contains cell A1 value as 10. So this code is actually a loop which is returning values to cell A2 till it becomes 10 after each half second. You can increase or decrease the speed by changing it.

Now Link this code to a button on the spreadsheet.

STEP NO.4

In VB window,  click on the worksheet where you have added these headline shapes. and add the below VB code on the change event.

You have to change the names of your pictures in the code.

VB CODE:


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 2 And Target.Column = 1 Then

If ActiveSheet.Range("A2").Value = 0 Then
ActiveSheet.Shapes("Shape-1").Visible = True
ActiveSheet.Shapes("Shape-2").Visible = False
ActiveSheet.Shapes("Shape-3").Visible = False
ActiveSheet.Shapes("Shape-4").Visible = False
ActiveSheet.Shapes("Shape-5").Visible = False
ActiveSheet.Shapes("Shape-6").Visible = False
ActiveSheet.Shapes("Shape-7").Visible = False
ActiveSheet.Shapes("Shape-8").Visible = False
ActiveSheet.Shapes("Shape-9").Visible = False

ActiveSheet.Shapes("Shape-10").Visible = True
ActiveSheet.Shapes("Shape-11").Visible = False
ActiveSheet.Shapes("Shape-12").Visible = False
ActiveSheet.Shapes("Shape-13").Visible = False
ActiveSheet.Shapes("Shape-14").Visible = False
ActiveSheet.Shapes("Shape-15").Visible = False
ActiveSheet.Shapes("Shape-16").Visible = False
ActiveSheet.Shapes("Shape-17").Visible = False
ActiveSheet.Shapes("Shape-31").Visible = False

ActiveSheet.Shapes("Shape-18").Visible = True
ActiveSheet.Shapes("Shape-19").Visible = False
ActiveSheet.Shapes("Shape-20").Visible = False
ActiveSheet.Shapes("Shape-21").Visible = False
ActiveSheet.Shapes("Shape-22").Visible = False
ActiveSheet.Shapes("Shape-23").Visible = False
ActiveSheet.Shapes("Shape-24").Visible = False
ActiveSheet.Shapes("Shape-32").Visible = False
ActiveSheet.Shapes("Shape-33").Visible = False

ActiveSheet.Shapes("Shape-25").Visible = True
ActiveSheet.Shapes("Shape-26").Visible = False
ActiveSheet.Shapes("Shape-27").Visible = False
ActiveSheet.Shapes("Shape-28").Visible = False
ActiveSheet.Shapes("Shape-29").Visible = False
ActiveSheet.Shapes("Shape-30").Visible = False
ActiveSheet.Shapes("Shape-34").Visible = False
ActiveSheet.Shapes("Shape-35").Visible = False
ActiveSheet.Shapes("Shape-36").Visible = False




End If

If ActiveSheet.Range("A2").Value = 1 Then
ActiveSheet.Shapes("Shape-1").Visible = False
ActiveSheet.Shapes("Shape-2").Visible = True
ActiveSheet.Shapes("Shape-3").Visible = False
ActiveSheet.Shapes("Shape-4").Visible = False
ActiveSheet.Shapes("Shape-5").Visible = False
ActiveSheet.Shapes("Shape-6").Visible = False
ActiveSheet.Shapes("Shape-7").Visible = False
ActiveSheet.Shapes("Shape-8").Visible = False
ActiveSheet.Shapes("Shape-9").Visible = False

ActiveSheet.Shapes("Shape-10").Visible = False
ActiveSheet.Shapes("Shape-11").Visible = True
ActiveSheet.Shapes("Shape-12").Visible = False
ActiveSheet.Shapes("Shape-13").Visible = False
ActiveSheet.Shapes("Shape-14").Visible = False
ActiveSheet.Shapes("Shape-15").Visible = False
ActiveSheet.Shapes("Shape-16").Visible = False
ActiveSheet.Shapes("Shape-17").Visible = False
ActiveSheet.Shapes("Shape-31").Visible = False

ActiveSheet.Shapes("Shape-18").Visible = False
ActiveSheet.Shapes("Shape-19").Visible = True
ActiveSheet.Shapes("Shape-20").Visible = False
ActiveSheet.Shapes("Shape-21").Visible = False
ActiveSheet.Shapes("Shape-22").Visible = False
ActiveSheet.Shapes("Shape-23").Visible = False
ActiveSheet.Shapes("Shape-24").Visible = False
ActiveSheet.Shapes("Shape-32").Visible = False
ActiveSheet.Shapes("Shape-33").Visible = False

ActiveSheet.Shapes("Shape-25").Visible = False
ActiveSheet.Shapes("Shape-26").Visible = True
ActiveSheet.Shapes("Shape-27").Visible = False
ActiveSheet.Shapes("Shape-28").Visible = False
ActiveSheet.Shapes("Shape-29").Visible = False
ActiveSheet.Shapes("Shape-30").Visible = False
ActiveSheet.Shapes("Shape-34").Visible = False
ActiveSheet.Shapes("Shape-35").Visible = False
ActiveSheet.Shapes("Shape-36").Visible = False


End If

If ActiveSheet.Range("A2").Value = 2 Then
ActiveSheet.Shapes("Shape-1").Visible = False
ActiveSheet.Shapes("Shape-2").Visible = False
ActiveSheet.Shapes("Shape-3").Visible = True
ActiveSheet.Shapes("Shape-4").Visible = False
ActiveSheet.Shapes("Shape-5").Visible = False
ActiveSheet.Shapes("Shape-6").Visible = False
ActiveSheet.Shapes("Shape-7").Visible = False
ActiveSheet.Shapes("Shape-8").Visible = False
ActiveSheet.Shapes("Shape-9").Visible = False

ActiveSheet.Shapes("Shape-10").Visible = False
ActiveSheet.Shapes("Shape-11").Visible = False
ActiveSheet.Shapes("Shape-12").Visible = True
ActiveSheet.Shapes("Shape-13").Visible = False
ActiveSheet.Shapes("Shape-14").Visible = False
ActiveSheet.Shapes("Shape-15").Visible = False
ActiveSheet.Shapes("Shape-16").Visible = False
ActiveSheet.Shapes("Shape-17").Visible = False
ActiveSheet.Shapes("Shape-31").Visible = False

ActiveSheet.Shapes("Shape-18").Visible = False
ActiveSheet.Shapes("Shape-19").Visible = False
ActiveSheet.Shapes("Shape-20").Visible = True
ActiveSheet.Shapes("Shape-21").Visible = False
ActiveSheet.Shapes("Shape-22").Visible = False
ActiveSheet.Shapes("Shape-23").Visible = False
ActiveSheet.Shapes("Shape-24").Visible = False
ActiveSheet.Shapes("Shape-32").Visible = False
ActiveSheet.Shapes("Shape-33").Visible = False

ActiveSheet.Shapes("Shape-25").Visible = False
ActiveSheet.Shapes("Shape-26").Visible = False
ActiveSheet.Shapes("Shape-27").Visible = True
ActiveSheet.Shapes("Shape-28").Visible = False
ActiveSheet.Shapes("Shape-29").Visible = False
ActiveSheet.Shapes("Shape-30").Visible = False
ActiveSheet.Shapes("Shape-34").Visible = False
ActiveSheet.Shapes("Shape-35").Visible = False
ActiveSheet.Shapes("Shape-36").Visible = False


End If


If ActiveSheet.Range("A2").Value = 3 Then
ActiveSheet.Shapes("Shape-1").Visible = False
ActiveSheet.Shapes("Shape-2").Visible = False
ActiveSheet.Shapes("Shape-3").Visible = False
ActiveSheet.Shapes("Shape-4").Visible = True
ActiveSheet.Shapes("Shape-5").Visible = False
ActiveSheet.Shapes("Shape-6").Visible = False
ActiveSheet.Shapes("Shape-7").Visible = False
ActiveSheet.Shapes("Shape-8").Visible = False
ActiveSheet.Shapes("Shape-9").Visible = False

ActiveSheet.Shapes("Shape-10").Visible = False
ActiveSheet.Shapes("Shape-11").Visible = False
ActiveSheet.Shapes("Shape-12").Visible = False
ActiveSheet.Shapes("Shape-13").Visible = True
ActiveSheet.Shapes("Shape-14").Visible = False
ActiveSheet.Shapes("Shape-15").Visible = False
ActiveSheet.Shapes("Shape-16").Visible = False
ActiveSheet.Shapes("Shape-17").Visible = False
ActiveSheet.Shapes("Shape-31").Visible = False

ActiveSheet.Shapes("Shape-18").Visible = False
ActiveSheet.Shapes("Shape-19").Visible = False
ActiveSheet.Shapes("Shape-20").Visible = False
ActiveSheet.Shapes("Shape-21").Visible = True
ActiveSheet.Shapes("Shape-22").Visible = False
ActiveSheet.Shapes("Shape-23").Visible = False
ActiveSheet.Shapes("Shape-24").Visible = False
ActiveSheet.Shapes("Shape-32").Visible = False
ActiveSheet.Shapes("Shape-33").Visible = False

ActiveSheet.Shapes("Shape-25").Visible = False
ActiveSheet.Shapes("Shape-26").Visible = False
ActiveSheet.Shapes("Shape-27").Visible = False
ActiveSheet.Shapes("Shape-28").Visible = True
ActiveSheet.Shapes("Shape-29").Visible = False
ActiveSheet.Shapes("Shape-30").Visible = False
ActiveSheet.Shapes("Shape-34").Visible = False
ActiveSheet.Shapes("Shape-35").Visible = False
ActiveSheet.Shapes("Shape-36").Visible = False


End If

If ActiveSheet.Range("A2").Value = 4 Then
ActiveSheet.Shapes("Shape-1").Visible = False
ActiveSheet.Shapes("Shape-2").Visible = False
ActiveSheet.Shapes("Shape-3").Visible = False
ActiveSheet.Shapes("Shape-4").Visible = False
ActiveSheet.Shapes("Shape-5").Visible = True
ActiveSheet.Shapes("Shape-6").Visible = False
ActiveSheet.Shapes("Shape-7").Visible = False
ActiveSheet.Shapes("Shape-8").Visible = False
ActiveSheet.Shapes("Shape-9").Visible = False

ActiveSheet.Shapes("Shape-10").Visible = False
ActiveSheet.Shapes("Shape-11").Visible = False
ActiveSheet.Shapes("Shape-12").Visible = False
ActiveSheet.Shapes("Shape-13").Visible = False
ActiveSheet.Shapes("Shape-14").Visible = True
ActiveSheet.Shapes("Shape-15").Visible = False
ActiveSheet.Shapes("Shape-16").Visible = False
ActiveSheet.Shapes("Shape-17").Visible = False
ActiveSheet.Shapes("Shape-31").Visible = False

ActiveSheet.Shapes("Shape-18").Visible = False
ActiveSheet.Shapes("Shape-19").Visible = False
ActiveSheet.Shapes("Shape-20").Visible = False
ActiveSheet.Shapes("Shape-21").Visible = False
ActiveSheet.Shapes("Shape-22").Visible = True
ActiveSheet.Shapes("Shape-23").Visible = False
ActiveSheet.Shapes("Shape-24").Visible = False
ActiveSheet.Shapes("Shape-32").Visible = False
ActiveSheet.Shapes("Shape-33").Visible = False

ActiveSheet.Shapes("Shape-25").Visible = False
ActiveSheet.Shapes("Shape-26").Visible = False
ActiveSheet.Shapes("Shape-27").Visible = False
ActiveSheet.Shapes("Shape-28").Visible = False
ActiveSheet.Shapes("Shape-29").Visible = True
ActiveSheet.Shapes("Shape-30").Visible = False
ActiveSheet.Shapes("Shape-34").Visible = False
ActiveSheet.Shapes("Shape-35").Visible = False
ActiveSheet.Shapes("Shape-36").Visible = False


End If

If ActiveSheet.Range("A2").Value = 5 Then
ActiveSheet.Shapes("Shape-1").Visible = False
ActiveSheet.Shapes("Shape-2").Visible = False
ActiveSheet.Shapes("Shape-3").Visible = False
ActiveSheet.Shapes("Shape-4").Visible = False
ActiveSheet.Shapes("Shape-5").Visible = False
ActiveSheet.Shapes("Shape-6").Visible = True
ActiveSheet.Shapes("Shape-7").Visible = False
ActiveSheet.Shapes("Shape-8").Visible = False
ActiveSheet.Shapes("Shape-9").Visible = False

ActiveSheet.Shapes("Shape-10").Visible = False
ActiveSheet.Shapes("Shape-11").Visible = False
ActiveSheet.Shapes("Shape-12").Visible = False
ActiveSheet.Shapes("Shape-13").Visible = False
ActiveSheet.Shapes("Shape-14").Visible = False
ActiveSheet.Shapes("Shape-15").Visible = True
ActiveSheet.Shapes("Shape-16").Visible = False
ActiveSheet.Shapes("Shape-17").Visible = False
ActiveSheet.Shapes("Shape-31").Visible = False

ActiveSheet.Shapes("Shape-18").Visible = False
ActiveSheet.Shapes("Shape-19").Visible = False
ActiveSheet.Shapes("Shape-20").Visible = False
ActiveSheet.Shapes("Shape-21").Visible = False
ActiveSheet.Shapes("Shape-22").Visible = False
ActiveSheet.Shapes("Shape-23").Visible = True
ActiveSheet.Shapes("Shape-24").Visible = False
ActiveSheet.Shapes("Shape-32").Visible = False
ActiveSheet.Shapes("Shape-33").Visible = False

ActiveSheet.Shapes("Shape-25").Visible = False
ActiveSheet.Shapes("Shape-26").Visible = False
ActiveSheet.Shapes("Shape-27").Visible = False
ActiveSheet.Shapes("Shape-28").Visible = False
ActiveSheet.Shapes("Shape-29").Visible = False
ActiveSheet.Shapes("Shape-30").Visible = True
ActiveSheet.Shapes("Shape-34").Visible = False
ActiveSheet.Shapes("Shape-35").Visible = False
ActiveSheet.Shapes("Shape-36").Visible = False


End If

If ActiveSheet.Range("A2").Value = 6 Then
ActiveSheet.Shapes("Shape-1").Visible = False
ActiveSheet.Shapes("Shape-2").Visible = False
ActiveSheet.Shapes("Shape-3").Visible = False
ActiveSheet.Shapes("Shape-4").Visible = False
ActiveSheet.Shapes("Shape-5").Visible = False
ActiveSheet.Shapes("Shape-6").Visible = False
ActiveSheet.Shapes("Shape-7").Visible = True
ActiveSheet.Shapes("Shape-8").Visible = False
ActiveSheet.Shapes("Shape-9").Visible = False

ActiveSheet.Shapes("Shape-10").Visible = False
ActiveSheet.Shapes("Shape-11").Visible = False
ActiveSheet.Shapes("Shape-12").Visible = False
ActiveSheet.Shapes("Shape-13").Visible = False
ActiveSheet.Shapes("Shape-14").Visible = False
ActiveSheet.Shapes("Shape-15").Visible = False
ActiveSheet.Shapes("Shape-16").Visible = True
ActiveSheet.Shapes("Shape-17").Visible = False
ActiveSheet.Shapes("Shape-31").Visible = False

ActiveSheet.Shapes("Shape-18").Visible = False
ActiveSheet.Shapes("Shape-19").Visible = False
ActiveSheet.Shapes("Shape-20").Visible = False
ActiveSheet.Shapes("Shape-21").Visible = False
ActiveSheet.Shapes("Shape-22").Visible = False
ActiveSheet.Shapes("Shape-23").Visible = False
ActiveSheet.Shapes("Shape-24").Visible = True
ActiveSheet.Shapes("Shape-32").Visible = False
ActiveSheet.Shapes("Shape-33").Visible = False

ActiveSheet.Shapes("Shape-25").Visible = False
ActiveSheet.Shapes("Shape-26").Visible = False
ActiveSheet.Shapes("Shape-27").Visible = False
ActiveSheet.Shapes("Shape-28").Visible = False
ActiveSheet.Shapes("Shape-29").Visible = False
ActiveSheet.Shapes("Shape-30").Visible = False
ActiveSheet.Shapes("Shape-34").Visible = True
ActiveSheet.Shapes("Shape-35").Visible = False
ActiveSheet.Shapes("Shape-36").Visible = False


End If

If ActiveSheet.Range("A2").Value = 7 Then
ActiveSheet.Shapes("Shape-1").Visible = False
ActiveSheet.Shapes("Shape-2").Visible = False
ActiveSheet.Shapes("Shape-3").Visible = False
ActiveSheet.Shapes("Shape-4").Visible = False
ActiveSheet.Shapes("Shape-5").Visible = False
ActiveSheet.Shapes("Shape-6").Visible = False
ActiveSheet.Shapes("Shape-7").Visible = False
ActiveSheet.Shapes("Shape-8").Visible = True
ActiveSheet.Shapes("Shape-9").Visible = False

ActiveSheet.Shapes("Shape-10").Visible = False
ActiveSheet.Shapes("Shape-11").Visible = False
ActiveSheet.Shapes("Shape-12").Visible = False
ActiveSheet.Shapes("Shape-13").Visible = False
ActiveSheet.Shapes("Shape-14").Visible = False
ActiveSheet.Shapes("Shape-15").Visible = False
ActiveSheet.Shapes("Shape-16").Visible = False
ActiveSheet.Shapes("Shape-17").Visible = True
ActiveSheet.Shapes("Shape-31").Visible = False

ActiveSheet.Shapes("Shape-18").Visible = False
ActiveSheet.Shapes("Shape-19").Visible = False
ActiveSheet.Shapes("Shape-20").Visible = False
ActiveSheet.Shapes("Shape-21").Visible = False
ActiveSheet.Shapes("Shape-22").Visible = False
ActiveSheet.Shapes("Shape-23").Visible = False
ActiveSheet.Shapes("Shape-24").Visible = False
ActiveSheet.Shapes("Shape-32").Visible = True
ActiveSheet.Shapes("Shape-33").Visible = False

ActiveSheet.Shapes("Shape-25").Visible = False
ActiveSheet.Shapes("Shape-26").Visible = False
ActiveSheet.Shapes("Shape-27").Visible = False
ActiveSheet.Shapes("Shape-28").Visible = False
ActiveSheet.Shapes("Shape-29").Visible = False
ActiveSheet.Shapes("Shape-30").Visible = False
ActiveSheet.Shapes("Shape-34").Visible = False
ActiveSheet.Shapes("Shape-35").Visible = True
ActiveSheet.Shapes("Shape-36").Visible = False


End If

If ActiveSheet.Range("A2").Value = 8 Then
ActiveSheet.Shapes("Shape-1").Visible = False
ActiveSheet.Shapes("Shape-2").Visible = False
ActiveSheet.Shapes("Shape-3").Visible = False
ActiveSheet.Shapes("Shape-4").Visible = False
ActiveSheet.Shapes("Shape-5").Visible = False
ActiveSheet.Shapes("Shape-6").Visible = False
ActiveSheet.Shapes("Shape-7").Visible = False
ActiveSheet.Shapes("Shape-8").Visible = False
ActiveSheet.Shapes("Shape-9").Visible = True

ActiveSheet.Shapes("Shape-10").Visible = False
ActiveSheet.Shapes("Shape-11").Visible = False
ActiveSheet.Shapes("Shape-12").Visible = False
ActiveSheet.Shapes("Shape-13").Visible = False
ActiveSheet.Shapes("Shape-14").Visible = False
ActiveSheet.Shapes("Shape-15").Visible = False
ActiveSheet.Shapes("Shape-16").Visible = False
ActiveSheet.Shapes("Shape-17").Visible = False
ActiveSheet.Shapes("Shape-31").Visible = True

ActiveSheet.Shapes("Shape-18").Visible = False
ActiveSheet.Shapes("Shape-19").Visible = False
ActiveSheet.Shapes("Shape-20").Visible = False
ActiveSheet.Shapes("Shape-21").Visible = False
ActiveSheet.Shapes("Shape-22").Visible = False
ActiveSheet.Shapes("Shape-23").Visible = False
ActiveSheet.Shapes("Shape-24").Visible = False
ActiveSheet.Shapes("Shape-32").Visible = False
ActiveSheet.Shapes("Shape-33").Visible = True

ActiveSheet.Shapes("Shape-25").Visible = False
ActiveSheet.Shapes("Shape-26").Visible = False
ActiveSheet.Shapes("Shape-27").Visible = False
ActiveSheet.Shapes("Shape-28").Visible = False
ActiveSheet.Shapes("Shape-29").Visible = False
ActiveSheet.Shapes("Shape-30").Visible = False
ActiveSheet.Shapes("Shape-34").Visible = False
ActiveSheet.Shapes("Shape-35").Visible = False
ActiveSheet.Shapes("Shape-36").Visible = True

End If

End If

End Sub


Having added this code, your headline shapes bar shall be working now as below. Other parts of this dashboard shall be covered in the coming posts so don't forget to subscribe to stay updated.

--------------











Comments

  1. Anupama Balan MenonApril 27, 2020 at 10:13 PM

    Could you pse throw some light on Step No.4? All good till the first 3 steps...but I am unable to understand how to execute Step 4.

    ReplyDelete
    Replies
    1. VickyApril 27, 2020 at 11:10 PM

      Hi Anupama. On the Dashboard, four shapes are moving from left to right physically. These are not four shapes in fact. Each shape has 9 copies which are placed from left to right. VBA code in step no. 4 is changing the visibility of those shapes when a cell value is changed by First VBA Code. First VBA code is changing "A2"cell values after interval and second VBA code is changing the shapes visibility...

      Delete

Post a Comment