Sub Popup()
Dim Shp As Shape
With ActiveSheet
For Each Shp In .Shapes
If Left(Shp.Name, 2) = "S_" Then
.Hyperlinks.Add Anchor:=Shp, Address:="", ScreenTip:=Info(Mid(Shp.Name, 3))
End If
Next Shp
End With
UpdateMap
End Sub
Private Function Info(ByVal Str As String) As String
Dim Res As String
Dim c As Range
Application.ScreenUpdating = False
If Str <> "" Then
Set c = Worksheets("Data").Range("D5:D52").Find(Str, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Res = "=[" & c.Offset(0, -1) & "]=:" & vbNewLine
Res = Res & " - Conversion: " & c.Offset(0, 1) & vbNewLine
Res = Res & " - Visits: " & c.Offset(0, 2) & vbNewLine
Res = Res & " - Revenue: " & Format(c.Offset(0, 3), "Currency")
Set c = Nothing
End If
End If
Info = Res
End Function