Home » Blogs » Ashish Koul's blog

India Heat Map on Excel

Submitted by Ashish Koul on 8 May, 2013 - 15:33
 
Using the method described by "www.clearlyandsimply.com" in his post. 

http://www.clearlyandsimply.com/clearly_and_simply/2009/06/choropleth-maps-with-excel.html
I have created a heat map for INDIA. Download and try it
Download Link https://www.box.com/s/yaanvkt7vltoyd5np18g
All credit goes to 'www.clearlyandsimply.com’ team. 
Please visit 'www.clearlyandsimply.com’ to download and try for various country/region maps on Excel


Below macro is used  to color the shapes and add hyperlink screen tips to give mouse hover effect 



Sub drp_down1()

 
'Thanks To http://www.clearlyandsimply.com/about.html for posting wonderful stuff on the website
'Please note all color codes and idea behind creating this map is picked from http://www.clearlyandsimply.com
'Please visit his site for amazing map charts on Excel
'http://www.clearlyandsimply.com/clearly_and_simply/2009/06/choropleth-maps-with-excel.html
 
 
Dim shp As Object
Dim i As Long, j As Long
 
' check the color selection made
With Sheet1.Shapes("drp_down1").ControlFormat
    Sheet2.Range("d1").Value = .List(.ListIndex)
End With
    
' remove all the exisiting color from shapes on map
For Each shp In Sheets("Map").Shapes
    On Error Resume Next
    shp.Fill.ForeColor.RGB = RGB(192, 192, 192)
Next
 
On Error GoTo 0
 
' add them color as per the slaes rank
For i = 1 To Sheets("Data").Range("a65356").End(xlUp).Row
    For Each shp In Sheets("Map").Shapes
        If UCase(shp.Name) = UCase(Sheets("Data").Range("c" & i).Text) Then
            shp.Fill.ForeColor.RGB = Sheets("Data").Range("d" & i).Value
            
            ' add tool tip to show mouseover effect
            If shp.Type <> msoGroup Then
                Sheet1.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="a1", ScreenTip:=Sheets("Data").Range("a" & i).Text & vbCrLf & "Sales - " & Sheets("Data").Range("b" & i).Text
            Else
                For j = 1 To shp.GroupItems.Count
                    Sheet3.Hyperlinks.Add Anchor:=shp.GroupItems(j), Address:="", SubAddress:="a1", ScreenTip:=Sheets("Data").Range("a" & i).Text & vbCrLf & "Sales - " & Sheets("Data").Range("b" & i).Text
                Next
            End If
            
            
            Exit For
        End If
    Next
Next
 
End Sub



Download the working file and test it

https://www.box.com/s/yaanvkt7vltoyd5np18g


Steps to use

 

 

 

 

 

»