Multiple Shape Color at the same time.

[richie247]

i have been running this code which works well however sometimes there is a overlap of the times, for each shape. ideally I want it to show 2 or more colours depending if there is multiple true cases. Hopefully there is someone who knows if this can be done.

Sub ShowHideAreas()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long
Dim wRGB As Variant, shp As Object
'
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
'
sh1.Select
For Each shp In sh1.Shapes
If LCase(Left(shp.Name, 6)) = LCase("Area_A") Then
shp.Visible = False
End If
Next
'
For i = 2 To sh2.Range("C" & Rows.Count).End(xlUp).Row
For j = 1 To 52
If sh2.Cells(i, Columns("G").Column + j - 1).Value = True Then
sh1.Shapes.Range(Array("Area_A" & j)).Visible = True
Select Case sh2.Range("C" & i)
Case "number 1": wRGB = RGB(255, 204, 153)
Case "number 2": wRGB = RGB(255, 255, 0)
Case "number 3": wRGB = RGB(51, 102, 255)
Case "number 4": wRGB = RGB(255, 0, 0)
Case "number 5": wRGB = RGB(204, 153, 255)
Case "number 6": wRGB = RGB(255, 255, 255)
End Select
sh1.Shapes.Range(Array("Area_A" & j)).Select
Selection.ShapeRange.Fill.ForeColor.RGB = wRGB
End If
Next
Next
MsgBox "Done"
End Sub

many thanks in advance

 

[pbornemeier]

How can you have multiple true cases if there can only be 6 cases: "number1" ,,,, "number6"

Please explain "however sometimes there is a overlap of the times, for each shape. "

If you want different colors based on the possibility of multiple true cases you will have to modify the code to be a series of if-then statements and somehow combine the individual RGB values to ghet the colors you want based on the possible combinations.

'6 taken 0 at a time = 1
'6 taken 1 at a time = 6
'6 taken 2 at a time = 15
'6 taken 3 at a time = 20
'6 taken 4 at a time = 15
'6 taken 5 at a time = 6
'6 taken 6 at a time = 1
' ----
'Possible Combinations 64

I am not sure if you can select enough colors to be readily distinguishable for 64 possibilities.