Defining Cell Value Based on Shape Color

**RunRabbit13** · 11-11-2016, 11:43 AM

Hello,

As I was watching the election results in the United States, I wanted to have an interactive map where I could click a state and assign the electoral value to either Democrat or Republican. I have a map and have successfully gotten the states to changes colors based on clicking it. What I am looking to do is assign the value to either Democrat or Republican. The code I have is below but I cannot get the cell to update based on the color of the shape. I know something is going wrong with my if statement but before I spend too much more time on it I want to make sure this is even possible.

Any help is appreciated - just thought this would be cool to have.

Sub Minnesota()
Dim Minnesota As Shape
    With Sheets("MainMap").Shapes("MINNESOTA").Fill.ForeColor
        Select Case .RGB
            Case vbRed
                .RGB = vbBlue
            Case Else
                .RGB = vbRed
        End Select
    End With
If Minnesota = vbRed Then Sheets("Control", Range("C24")) = 10

End Sub

**mikerickson** · 11-11-2016, 12:18 PM

What I would do is make a list of all the states somewhere in the workbook and have the routine change not only the color of the state, but also the entry in the list.
It looks like you already have shapes named for each of the states.

Put this code in your workbook and run the sub SetUp, thereafter, clicking on one of the states should both change its color and the list of who voted for whom.

(The attached demo file has only three states)

Sub SetUp()
    Dim uiCell As Range
    Dim i As Long
    On Error Resume Next
    Set uiCell = Application.InputBox("Where do you want the state list?", Type:=8)
    On Error GoTo 0
    If uiCell Is Nothing Then Exit Sub
    
    uiCell.Cells(1, 1).Name = "StateList"
    With Sheets("MainMap")
        For i = 1 To .Shapes.Count
            With .Shapes(i)
                .OnAction = "State_Click"
                Range("StateList").Cells(i, 1).Value = .Name
                Range("StateList").Cells(i, 2).Value = IIf(.Fill.ForeColor.RGB = vbRed, "Rep", "Dem")
            End With
        Next i
    End With
End Sub


Sub State_Click()
    Dim stateName As String
    Dim stateRange As Range
    With ActiveSheet.Shapes(Application.Caller)
        stateName = .Name
        Set stateRange = Range("StateList").EntireColumn.Find(what:=stateName)
        If .Fill.ForeColor.RGB = vbRed Then
            .Fill.ForeColor.RGB = vbBlue
            stateRange.Offset(0, 1).Value = "Dem"
        Else
            .Fill.ForeColor.RGB = vbRed
            stateRange.Offset(0, 1).Value = "Rep"
        End If
    End With
End Sub