building Heatmap

No body has yet replied to my query...Can someone look into this urgently??

This feature of heat map is available in excel 2007. I am using excel 2003 and hence need to achieve the same through some macro..

kindly help on this...

Thanks & Regards

This code get data from data sheet and put data in result and heatmap sheet.
I hope it can help you.

Sub Macro1()
   Dim heatMapSh As Worksheet
   Dim resultSh As Worksheet
   Dim dataSh As Worksheet
   Dim lastRow As Long, myRow As Long
   Dim hmLastrow As Long
   Dim r As Long, r2 As Long
   Dim myKey As String, keysNum As Long
   Dim elem As Variant
   Dim myText As String
   Dim fromValue As Single, toValue As Single
   Dim myValue As Single, cluster As String
   Dim destRow As Long, destCol As Integer
   
   Dim dic1 As Object
   Dim dic2 As Object
   
   Set heatMapSh = ThisWorkbook.Sheets("heatmap")
   Set resultSh = ThisWorkbook.Sheets("result")
   Set dataSh = ThisWorkbook.Sheets("data")
   
   Set dic1 = CreateObject("scripting.dictionary")
   Set dic2 = CreateObject("scripting.dictionary")
   
   'read data sheet for unique circle + cluster and zone
   For r = 2 To dataSh.UsedRange.Rows.Count
      myKey = dataSh.Cells(r, "a") & "," & dataSh.Cells(r, "e")
      If Not dic1.exists(myKey) Then
         dic1.Add Item:="", key:=myKey
      End If
   
      myKey = dataSh.Cells(r, "d")
      If Not dic2.exists(myKey) Then
         dic2.Add Item:="", key:=myKey
      End If
   Next r
   
   
   'put data on result sheet
   resultSh.Range("2:" & Rows.Count).ClearContents
   
   myRow = 1
   For Each elem In dic1.keys
      myRow = myRow + 1
      resultSh.Cells(myRow, "a") = Split(elem, ",")(0)
      resultSh.Cells(myRow, "b") = Split(elem, ",")(1)
   Next elem
   resultSh.Range("c2:c" & myRow).Formula = "=SUMIF(Data!$E:$E,Result!B2,Data!$C:$C)"
   resultSh.Range("d2:d" & myRow).Formula = "=COUNTIF(Data!E:E,Result!B2)"
   resultSh.Range("e2:e" & myRow).Formula = "=((1440*31*D2)-C2)/(1440*31*D2)*100"
   lastRow = myRow
   
   myRow = 1
   For Each elem In dic2.keys
      myRow = myRow + 1
      resultSh.Cells(myRow, "g") = elem
   Next elem
   resultSh.Range("h2:h" & myRow).Formula = "=SUMIF(Data!D:D,Result!G2,Data!C:C)"
   resultSh.Range("i2:i" & myRow).Formula = "=COUNTIF(Data!D:D,G2)"
   resultSh.Range("j2:j" & myRow).Formula = "=((1440*31*I2)-H2)/(1440*31*I2)*100"

   'put data on heatmap sheet
   With heatMapSh.Range("d:d").Resize(, Columns.Count - 4)
      .ClearContents
      .Interior.ColorIndex = xlNone
   End With
   hmLastrow = heatMapSh.Cells(Rows.Count, "b").End(xlUp).Row
   For r = 2 To lastRow
      myValue = Round(resultSh.Cells(r, "e"), 2)
      cluster = resultSh.Cells(r, "b")
      
      For r2 = 3 To hmLastrow
         If Trim(heatMapSh.Cells(r2, "b")) <> "" Then
            myText = heatMapSh.Cells(r2, "b")

            If heatMapSh.Cells(r2, "b") Like "*<*" Then
               fromValue = Evaluate(Mid(myText, 2))
               If myValue < fromValue Then
                  destRow = r2
                  Exit For
               End If
            ElseIf heatMapSh.Cells(r2, "b") Like "*>*" Then
               fromValue = Evaluate(Mid(myText, 2))
               If myValue > fromValue Then
                  destRow = r2
                  Exit For
               End If
            ElseIf heatMapSh.Cells(r2, "b") Like "*-*" Then
               sep = InStr(myText, "-")
               toValue = Evaluate(Left(myText, sep - 1))
               fromValue = Evaluate(Mid(myText, sep + 1))
               If myValue >= fromValue And myValue <= toValue Then
                  destRow = r2
                  Exit For
               End If
            End If
         End If
      Next r2
       
      With heatMapSh
         destCol = .Cells(destRow, Columns.Count).End(xlToLeft).Column + 1
         If destCol < 4 Then destCol = 4
         .Cells(destRow, destCol) = cluster
         .Cells(destRow, destCol).Interior.ColorIndex = .Cells(destRow, "b").Interior.ColorIndex
         .Cells(destRow, destCol).Font.Size = 8
      End With
   Next r
   heatMapSh.Range("d:d").Resize(, Columns.Count - 3).Columns.AutoFit
End Sub

Regards,
Antonio

Thanks for your reply...but I am facing some error while executing the macro...

error is attached with the mail..kindly help to rectify the same...

thanks...

I apologize for the error.

Regards,
Antonio

Thanks a lot for the superb solution...

I need few more enhancement to the same..may be I am asking too much...but I know you people can only make it work for me.

a) In the heatmap prepared, I need a column with the count of cluster falling under defined range..shown in the file attached..

b) I want that only 10 cluster would be shown in a single line and if clusters are more than 10, it would accomodate in another line and range would also adjust...shown in the file attached.

c) I want to show the uptime% in bracket along with the cluster name.this is also shown for some of the clusters in the file attached...

I am bothering you guys too much..thanks for the cooperation till date..