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
|