Excel VBA Tutorial - Using VBA to show blinking symbol on a Map
My colleague Ms. Chee SK (LinkedIn) conducted an Excel Executive Training for a corporate Singapore-based customer recently. They need to use Excel to indicate which MRT station is the nearest to their customer's location or customer specified landmark. Example, for a landmark called WestMall, the nearest MRT station is Bukit Batok. A symbol shall be displayed and blinking on a MRT map.
I then explore the possibility to use Excel VBA to accomplish this. Here are my work.
1. First, put the map image on a worksheet called Map.
2. Select the cell below the map, example cell D15, which is closest to Bukit Batok. Set the Name to "BukitBetok".
3. Put a graphic. Set the Name to "myoutlet".
4. You have another worksheet, that have many landmarks, next of the WestMall landmarks, put a hyperlink to jump to named cell "BukitBatok".
5. Here is fun part. When the cursor is at "BukitBetok" cell due to the hyperlink. We need VBA to detect there is SelectionChange happens. It then check whether the cell has Name. I have Outletname function to check the availability of the Name. If yes, it moves the "myoutlet" symbol to the cell. Plus, we need the symbol to blink few seconds. I have Blinking subroutine to do blinking.
Here is the code in the Map worksheet module.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Outletname(Target)
Case "BukitBatok"
Worksheets("Map").Shapes("myoutlet").Top = Target.Top
Worksheets("Map").Shapes("myoutlet").Left = Target.Left
Blinking
Case Else
Worksheets("Map").Shapes("myoutlet").Top = Worksheets("Map").Range("T1").Top
Worksheets("Map").Shapes("myoutlet").Left = Worksheets("Map").Range("T1").Left
End Select
End Sub
Sub Blinking()
Dim n As Integer
Dim mytime
For n = 1 To 20
Worksheets("Map").Shapes("myoutlet").Visible = Not Worksheets("Map").Shapes("myoutlet").Visible
mytime = Time + 1 / 60 / 60 / 24
'Wait 1 sec.
While mytime > Time
DoEvents
Wend
Next
End Sub
Function Outletname(Target As Range) As String
On Error Resume Next
Dim nm As Name, r As Range
Outletname = ""
For Each nm In Application.Names
Set r = Application.Intersect(Target, Range(nm.Name))
If Not r Is Nothing Then
Outletname = nm.Name
Exit For
End If
Next nm
End Function
6. For other MRT stations, you can repeat step 4. And, don't forget also, in the SelectionChange subroutine, add the case clause for the new station.
Case "XXX"
Worksheets("Map").Shapes("myoutlet").Top = Target.Top
Worksheets("Map").Shapes("myoutlet").Left = Target.Left
Blinking