Function O_Mau(rCell As Range, Optional TenColor As Boolean)
Dim StrMau As String, iChiSo As Integer

iChiSo = rCell.Interior.ColorIndex
Select Case iChiSo
 Case 1
 StrMau = "Black"
 Case 2: StrMau = "White"
 Case 3: StrMau = "Red"
 Case 4: StrMau = "Bright Green"
 Case 5: StrMau = "Blue"
 Case 6: StrMau = "Yellow"
 Case 7: StrMau = "Pink"
 Case 8: StrMau = "Turqoise"
 Case 9: StrMau = "Dark Red"
 Case 10: StrMau = "Green"
 Case 11: StrMau = "Dark Blue"
 Case 12: StrMau = "Dark Yellow"
 Case 13: StrMau = "Violet"
 Case 14: StrMau = "Teal"
 Case 15: StrMau = "Gray-25%"
 Case 16: StrMau = "Gray-50%"
 
 Case 33: StrMau = "Sky Blue"
 Case 34: StrMau = "Light Turqoise"
 Case 35: StrMau = "Light Green"
 Case 36: StrMau = "Light Yellow"
 Case 37: StrMau = "Pale Blue"
 Case 38: StrMau = "Rose"
 Case 39: StrMau = "Lavendar"
 Case 40: StrMau = "Tan"
 Case 41: StrMau = "Light Blue"
 Case 42: StrMau = "Aqua"
 Case 43: StrMau = "Lime"
 Case 44: StrMau = "Gold"
 Case 45: StrMau = "Light Orange"
 Case 46: StrMau = "Orange"
 Case 47: StrMau = "Blue-Gray"
 Case 48: StrMau = "Gray-40%"
 Case 49: StrMau = "Dark Teal"
 Case 50: StrMau = "Sea Green"
 Case 51: StrMau = "Dark Green"
 Case 52: StrMau = "Olive Green"
 Case 53: StrMau = "Brown"
 Case 54: StrMau = "Plum"
 Case 55: StrMau = "Indigo"
 Case 56: StrMau = "Gray-80%"
 Case Else: StrMau = "Custom color or no fill"
 End Select

 O_Mau = iChiSo & "- " & StrMau
 If TenColor = True Or StrMau = "Custom color or no fill" Then O_Mau = StrMau
End Function

Sub whiteONblue()
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual 'pre XL97 xlManua
 Dim cell As Range
 '---Range("A3:N100").Select 
 For Each cell In Selection
 If cell.Interior.colorindex = 41 And cell.Column = 4 Then
 cell.Font.colorindex = 2 '2=white, 6=yellow
 End If
 Next cell
 Application.Calculation = xlCalculationAutomatic 'pre XL97 xlManua
 Application.ScreenUpdating = False
End Sub

Sub XoaConstantsTuOMau()
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Dim Cell As Range
 On Error Resume Next 'In case no cells in selection
 Application.EnableEvents = False
 For Each Cell In Intersect(Selection, Cells.SpecialCells(xlConstants))
 If Cell.Interior.ColorIndex >= 0 Then Cell.ClearContents
 Next
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
End Sub

Sub ColorRowBasedOnCellValue()
 'David_McRitchie, 20010117
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Dim cell As Range
 For Each cell In Intersect(Selection, ActiveCell.EntireColumn, _
 ActiveSheet.UsedRange)
 Select Case cell.Value
 Case Is >= 50
 cell.EntireRow.Interior.ColorIndex = 20
 Case Is >= 40
 cell.EntireRow.Interior.ColorIndex = 37
 Case Is >= 20
 cell.EntireRow.Interior.ColorIndex = 38
 Case Is >= 0
 cell.EntireRow.Interior.ColorIndex = 36
 Case Else
 cell.EntireRow.Interior.ColorIndex = 44
 End Select
 Next cell
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = False
End Sub

Sub ColorOfAssignment()
 Dim rnG As Range, celL As Range
 Set rnG = Selection
 'rng.Interior.ColorIndex = xlAutomatic 'clear color
 For Each celL In Intersect(rnG, rnG.SpecialCells(xlFormulas))
 On Error Resume Next
 celL.Interior.ColorIndex = Range(Mid(celL.Formula, 2)).Interior.ColorIndex
 On Error GoTo 0
 Next celL
End Sub