View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
u473 u473 is offline
external usenet poster
 
Posts: 184
Default Fill cell values on Interiorcolor conditions

I resolved it by myself, it works and I am quite happy about it.
I could probably simplify it but that will be the next step.
One question remains, the ColorIndex of Black is 1 and White is 2.
To make my program work, I had to find that Black is -4105 and White
is -4142 ?
Where was I supposed to find this ?

Sub ColorTest()
Dim rng As Range: Dim iClr As Integer: Dim fClr As Integer
Dim Men As Integer
Set rng = Range("B2:F2"): Range("B2").Select
For Each Cell In rng
iClr = ActiveCell.Interior.ColorIndex: Men = Cell.Value
fClr = ActiveCell.Font.ColorIndex
Select Case iClr
Case 40
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 9
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 9
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 9
End If
Case 36
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 10
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 10
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 10
End If
Case 34
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 11
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 11
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 11
End If
Case 39
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 12
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 12
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 12
End If
Case Else
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 8
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 8
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 8
End If
End Select
ActiveCell.Offset(0, 1).Select
Next Cell
End Sub