VBA Routine To Set Excel Cell Color By Value

I though some one must have already done this, but I cannot find the ready to use code. So I had to write one myself:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Column

    Dim Row

    Dim Red

    Dim Green

    Dim heat

    For Each c In Target

        Column = c.Column

        Row = c.Row

        Rem # Define the range of the cells to change color, keep this to minimal for better performance

        If Column > 1 And Column <= 12 And Row > 1 And Row < 40 Then

            If c.Value = "" Then

                c.Interior.ColorIndex = -4142

            Else

                Rem # Calculate the heat. You can times c.Value by a factor to control the range

                heat = c.Value - 255

                If (heat > 255) Then heat = 255

                If (heat < -255) Then heat = -255

                Rem # Set back color of the cell

                If (heat > 0) Then

                    Green = 256 - heat

                    Red = 255

                Else

                    Green = 255

                    Red = 255 + heat

                End If

                c.Interior.Color = RGB(Red, Green, 0)

                Rem # Set fore color of the cell

                If (heat > 100) Then

                    c.Font.Color = vbWhite

                Else

                    c.Font.Color = vbBlack

                End If

            End If

        End If

    Next

End Sub

Change Drive Label and Icon in Windows 7

I can use registry to do this. Here is an example.

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons]

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\L]

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\L\DefaultIcon]

@="%SystemRoot%\\system32\\imageres.dll,176"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\L\DefaultLabel]

@="Source Code"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\O]

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\O\DefaultIcon]

@="%SystemRoot%\\system32\\imageres.dll,15"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\O\DefaultLabel]

@="Outlook"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\R]

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\R\DefaultIcon]

@="%SystemRoot%\\system32\\imageres.dll,-34"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\DriveIcons\R\DefaultLabel]

@="RAMDISK"