macro to change shape border color on cell entry

[bluepenink]

I have expense data by county. I have managed to link the shape of county to a cell, so i can show the county name or $ amount in the shape itself.

the issue is, the map of county doesnt fit some of the names of the counties in it as the shape is too small, so it looks messy.

issue:
-i would like to make the outline of the shape go "red' when user selects a particular county (i have provided an example in the attached link).

so basically, from my drop down list (cell C38), when i select a county, i want the outline of the shape for that county to have a "Red' border so user can visually see where it is located.

can someone pls help!

thx u

https://skydrive.live.com/redir.asp...sid=5E19C3EAA0C78B45!102&authkey=7Z9ug0JH*98$

 

[bluepenink]

any suggestions guys? pls help

 

[CWatts]

Most people (myself included) wont open file attachments, but here's something you could use or adapt.

I made three boxes and named them County1, County2, and County3.

In A1:A3, I put the names of the shapes I have (County1, County2, County3)

The following macro will check to make sure that the cell I click on is in that range, and if it is, it loops through and makes all the shapes blue, and then makes the selected shape's border red.

Hopefully this helps you get the ball rolling. (For example you can change the intersect to A1 only and have a1 be a data validation list of your counties.)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A3")) Is Nothing Then
    Dim Unselected As Long
    Dim Selected As Long

    Unselected = RGB(0, 0, 255)
    Selected = RGB(255, 0, 0)

    For Each sh In ActiveSheet.Shapes
        sh.Line.ForeColor.RGB = Unselected
        sh.Line.BackColor.RGB = Unselected
    Next

    ActiveSheet.Shapes(Target.Text).Line.ForeColor.RGB = Selected
    ActiveSheet.Shapes(Target.Text).Line.BackColor.RGB = Selected
Else
End If
End Sub

 

[bluepenink]

Hey bud

thxs for the help.

The cell reference i want is D36, which contains the drop down list. so i changed the macro as you mentioned, but it is not outling anything. I placed the macro in the worksheet "cook"

Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("D36")) Is Nothing Then
    Dim Unselected As Long
    Dim Selected As Long
    Unselected = RGB(0, 0, 255)
    Selected = RGB(255, 0, 0)
    For Each sh In ActiveSheet.Shapes
        sh.Line.ForeColor.RGB = Unselected
        sh.Line.BackColor.RGB = Unselected
    Next
    ActiveSheet.Shapes(Target.Text).Line.ForeColor.RGB = Selected
    ActiveSheet.Shapes(Target.Text).Line.BackColor.RGB = Selected
Else
End If
End Sub

....the code below is the code i use that adds a value to the shape

Sub SetShapeNameCookcounty()
    Dim shp As Drawing
    Dim i As Integer
    
    i = 1
    For Each shp In ActiveSheet.Drawings
         shp.Formula = "=" & ActiveSheet.Range("AM6").Offset(i, 0).Address
         i = i + 1
    Next shp
    Range("E6") = "Map sorted by: County Name"
End Sub

ur thoughts? thxs alot.

 

[CWatts]

I can't tell if there is a difference between drawing or shape so you may have to modify my code to work on drawings instead of shapes.

Also, make sure your shape/drawing is named the same as your dropdown box value becuase it uses that to evaluate the true/false test.