Worksheet code if-color-statement

[Jonsson]

Hi,

I'm trying to do a code without succeding, in Worksheet that says i
color =red or black:
Anyone?

IF B33=red, copy formula from BG4:BL33, paste in E4:J33
IF K3:M3=red, copy formula from BG4:BL33, paste in N4:S33
IF T3:V3=red, copy formula from BG4:BL33, paste in W4:AB33
IF AC3:AE3=red, copy formula from BG4:BL33, paste in AF4:AK33
IF AL3:AN3=red, copy formula from BG4:BL33, paste in AO4:AT33
IF AU3:AW3=red, copy formula from BG4:BL33, paste in AX4:BC33

IF B33=black, copy formula from BU4:BZ33, paste in E4:J33
IF K3:M3=black, copy formula from BU4:BZ33, paste in N4:S33
IF T3:V3=black, copy formula from BU4:BZ33, paste in W4:AB33
IF AC3:AE3=black, copy formula from BU4:BZ33, paste in AF4:AK33
IF AL3:AN3=black, copy formula from BU4:BZ33, paste in AO4:AT33
IF AU3:AW3=black, copy formula from BU4:BZ33, paste in AX4:BC33

Thanks in advance

//Thoma

 

[Tom Ogilvy]

If the colors are produced with conditional formatting, then you can not
determine what color is being displayed.

Assume the font color is what is being checked.

If the cells have been colored manually or with code, then you can look at
the interior.ColorIndex property of a single cell.

Sub BBBB()
Dim varr1 As Variant, varr2 As Variant
Dim varr As Variant, k As Long, i As Long
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim sDex As String
varr1 = Evaluate("{""B33"", ""BG4:BL33"",""E4:J33"", ""red"";" & _
"""K3:M3"", ""BG4:BL33"",""N4:S33"", ""red"";" & _
"""T3:V3"", ""BG4:BL33"",""W4:AB33"", ""red"";" & _
"""AC3:AE3"", ""BG4:BL33"",""AF4:AK33"", ""red"";" & _
"""AL3:AN3"", ""BG4:BL33"",""AO4:AT33"", ""red"";" & _
"""AU3:AW3"", ""BG4:BL33"",""AX4:BC33"", ""red""}")

varr2 = Evaluate("{""B33"", ""BU4:BZ33"", ""E4:J33"", ""black"";" & _
"""K3:M3"", ""BU4:BZ33"", ""N4:S33"", ""black"";" & _
"""T3:V3"", ""BU4:BZ33"", ""W4:AB33"", ""black"";" & _
"""AC3:AE3"", ""BU4:BZ33"", ""AF4:AK33"", ""black"";" & _
"""AL3:AN3"", ""BU4:BZ33"", ""AO4:AT33"", ""black"";" & _
"""AU3:AW3"", ""BU4:BZ33"", ""AX4:BC33"", ""black""}")
For k = 1 To 2
If k = 1 Then
varr = varr1
Else
varr = varr2
End If

For i = LBound(varr, 1) To UBound(varr, 1)
Set rng1 = Range(varr(i, 1))
Set rng2 = Range(varr(i, 2))
Set rng3 = Range(varr(i, 3))
sDex = varr(i, 4)
Next
Next

End Sub

Public Sub ProcData(rng1 As Range, rng2 As Range, _
rng3 As Range, sDex As Long)
Dim bAll As Boolean, cell As Range
Dim idex As Long
If LCase(sDex) = "red" Then
idex = 3
Else
idex = xlAutomatic
End If
bAll = True
For Each cell In rng1
If cell.Font.ColorIndex <> idex Then
bAll = False
Exit For
End If
Next
If bAll Then
rng2.Copy Destination:=rng3
End If
End Sub