EXCEL Q: How to Color Shapes Based off Date Ranges in Various Cells?

[gnider]

OK first off hello! I am new to these forums and - though I dabbled a bit in Basic when I was younger - new to programming in general. I have searched using Google rather extensively but cannot figure out how to do what I'm attempting...perhaps because I am having a hard time applying programming principles because I am new to macros and VBA.

I use Excel (2013) quite a bit to help organize large amounts of info, but am starting to push my limits when it comes to the program. I'm essentially trying to color shapes in worksheet 2 (WS2) based off 3 different date ranges in various cells in worksheet 1 (WS1). WS1 contains the data, which, in column A, lists all the counties in my state. In WS1 column C there is a date, showing the date establishments in that county were visited. Each county name in column A has a corresponding date in column C. (If it matters for my question, column C is conditionally formatted so the dated cell automatically highlights red, yellow, or green, depending on the date in the cell. If the date in the cell is within 12 months of the day the spreadsheet was opened, the cell automatically highlights itself green. If over 12 months old but under 24 months, cell highlights yellow. If 24 months or older, cell highlights red.)

Now the shapes. The shapes are actually shapes of each county in my state, inserted into WS2 from a .wfm file. It's essentially a state map with county boundaries. Each shape (each county) is named as such: "Kittson," for Kittson county, "Itasca," for Itasca county, and so on and so forth.

After an employee visits all establishments in a given county, the employee opens up this shared Excel workbook and changes the date in WS1 column C from whatever it was to the current day's date. At this point the dated cell in WS1 changes from yellow or red to green...unless the dated cell was green to begin with.

My question: How do I make each shape (county) in WS2 automatically highlight itself red, yellow, or green based off the dates in cells in WS1 column C using the same or similar <12, <24, >24 months conditionally formatting rule mentioned earlier?

Don't laugh, bit this is what I've come up with:

'NOTE if any of the cells change for county or zip respective cells, the following code MUST be adjusted
' accordingly else script will break!
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim sh As Shape
 
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("C2,C17,C18,C19,C20,C21,C22,C23,C24,C25,C26,C27,C28,C29,C30,C31"), Target) Is Nothing Then
 
        'Specify cell dates to look at and each cell date's corresponding couinty shape on state map
        With Sheets("STATE")
            Select Case Target.Address(0, 0)
                Case "C2": Set sh = .Shapes("Aitkin")
                Case "C17": Set sh = .Shapes("Becker")
                Case "C18": Set sh = .Shapes("Beltrami")
                Case "C19": Set sh = .Shapes("Benton")
                Case "C20": Set sh = .Shapes("Big_Stone")
                Case "C21": Set sh = .Shapes("Blue_Earth")
                Case "C22": Set sh = .Shapes("Brown")
                Case "C23": Set sh = .Shapes("Carlton")
                Case "C24": Set sh = .Shapes("Carver")
                Case "C25": Set sh = .Shapes("Cass")
                Case "C26": Set sh = .Shapes("Chippewa")
                Case "C27": Set sh = .Shapes("Chisago")
                Case "C28": Set sh = .Shapes("Clay")
                Case "C29": Set sh = .Shapes("Clearwater")
                Case "C30": Set sh = .Shapes("Cook")
                Case "C31": Set sh = .Shapes("Cottonwood")
 
            End Select
        End With
 
        'Set shape color
        Select Case Target.Value
            Case Is >= Now, -25: sh.Fill.ForeColor.RGB = vbYellow
            Case Is >= Now, -12: sh.Fill.ForeColor.RGB = vbGreen
            Case Is <= Now, -25: sh.Fill.ForeColor.RGB = vbRed
            Case Else: sh.Fill.ForeColor.RGB = vbWhite
        End Select
 
    End If
 
    End Sub
 
 

The above doesn't include all counties because I noticed pretty quickly that for reasons maybe obvious to you it didn't work. As you can see I attempted to call out each individual shape and cell because I didn't think a loop would work since WS1 column A doesn't include only counties. Yes, I lied earlier - WS1 column A contains mostly counties, except for those counties with 100 or more establishments. For THOSE counties the county is still named in, say, cell A2, but then A3 through A10 has zip codes with their respective dates in column C. Zip codes are not represented on my county state map. Those counties further separated by zip could remain not colored in WS2.

Last lie (I'm sorry) WS1 and WS2 have different names; WS1 and WS2 are named "Counties & Zip Codes" and "STATE," respectively, if this matters.

Lord knows I'm asking a lot. Any feedback would be greatly appreciated : )

[zmbd]

Never having done this myself in excel, conditional formatting of the cells is often enough for my work, it will take me a little bit to determine if this is possible. My thought is along the same as yours that the shape object properties are the way to go in this; however, I think that you may be stuck with the color that is embedded in the imported shape.
It might also help to give your cells in WS1:C# range names. My thought here is that you can then use the on change event with a select case against the range name to select the correct shape (once again if that is possible) for highlighting. The shapes I suspect are going to be handled a lot like they are in powerpoint or word... by shaperange.

Need to have a little bit more info on what you mean by highlight too... you can attach standard image files to your posts via the [Advanced] editor. If you use a third party site I may not be able to view them depending on which PC I'm at.


One thing to note: "Counties & Zip Codes" as an ampersand in the name... this is a no-no as the ampersand is a reserved token.

Although the following links refer to Access, the general premises are the same especially when it comes to VBA.
Access 2007 reserved words and symbols
AllenBrowne- Problem names and reserved words in Access



(( Just an aside: In Excel "Macros" and "VBA" are the same thing. In Access these are different programing languages. Thus, you can simply refer to VBA code in Excel and we'll follow right along. :) ))

[gnider]

Thanks for your reply, zmbd!

I've attached a .zip containing a .xlsm with the inserted .wmf I am using. The .wfm can also be found at http://www.mngeo.state.mn.us/maps/USmaps/index.html and is called "MN.WMF." I will attached my full workbook if it's determined I can. That maybe the most helpful.

Also to answer your question, by highlighting the shapes I mean fill color, really, the manual method being selecting the shape and then changing the fill color.

And the ampersand has been changed : ) Thanks again for guidance!

[zmbd]

As I suspected, we're going to have to treat the shapes in excel the same way we treat them in powerpoint...

SO here's the link leading to the bases from which I think we should start: ShapeRange Object

This link provides several examples as to how to handle the shape range. I suggest making a copy of your file and playing with these examples to see how they work in your project.

-z

[zmbd]

gnider:
+ Visited the site you linked to last night from home.

+If you are using that one giant shape, then you will not be able to selectively shade a section of that shape. Or, did you separate the counties into their own shapes?

[gnider]

zmbd,

The shape is odd in that it seems to have multiple "layers" when first imported into Excel: one layer as one big shape and the second layer "hiding" behind the first layer. I essentially deleted the first large layer, enabling me to play around with, move if I choose, or fill each individual shape in the second layer.

So you answer your question it isn't really one giant shape, or it doesn't have to be - it's multiple shapes lined up like a puzzle to form the image of a state map, but by county. Each county is its own shape!

I'm taking a look at the article to which you linked this evening. Thanks!

EDIT: In response to the edit regarding the attachment - I understand : ) Actually I didn't feel comfortable about adding the .zip for your stated reason, but my workbook is mac-enable, making it a .xlsm, which I think is not one of the standard files able to be attached, and the requested image referenced above is a .wmf, which is not a standard image file a thus also not able to be attached. I did try, though : ). But that's also why I added the link. Thanks again!

[zmbd]

OK,
I've played around with the image from the website link... thank you for pointing out the layers. I don't do much with WMF formats.

As I suspected, it works very much like the MSWord shapes.

Please copy and paste the following code into a new module in a copy of your workbook... from here the next step is to pass to your code the correct cell.


Two macros so that you can see how to both set and clear the fill.
I guessed at the names for the shapes being the county names.

Option Explicit
 
Sub SelectTwoandColour()
'
    ThisWorkbook.Worksheets("STATE").Shapes.Range(Array("Kittson")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
'Standard red
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ThisWorkbook.Worksheets("STATE").Shapes.Range(Array("Lake_of_the_Woods")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
'Standard blue
        .ForeColor.RGB = RGB(0, 112, 192)
        .Transparency = 0
        .Solid
    End With
 
End Sub
 
Sub SelectTwoandCLear()
'
    ThisWorkbook.Worksheets("STATE").Shapes.Range(Array("Kittson")).Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    ThisWorkbook.Worksheets("STATE").Shapes.Range(Array("Lake_of_the_Woods")).Select
    Selection.ShapeRange.Fill.Visible = msoFalse
End Sub
 

[gnider]

I see! This fills the correct shapes with the colors called out in code, which is great.

With my first bit of code at the top of this thread, every county called out was turning red, not red, yellow, or green based off its corresponding date in column C of WS1. This is where I was having trouble initially, but I like the way your code handles the fill color better I think. Now I just need to utilize correctly!

That said, I'm shooting to have the fill color of each shape "match" the date in its corresponding cell in WS1. I was attempting to do this earlier with the following code:

        Select Case Target.Value
            Case Is >= Now, -24: sh.Fill.ForeColor.RGB = vbYellow
            Case Is >= Now, -12: sh.Fill.ForeColor.RGB = vbGreen
            Case Is <= Now, -25: sh.Fill.ForeColor.RGB = vbRed
            Case Else: sh.Fill.ForeColor.RGB = vbWhite
        End Select
 

This, I had hoped, would color everything 24 months ago to the present yellow, 12 months ago to the present green, and anything older than 25 months red. Unfortunately it didn't.

Why?

Next, I wanted Excel to do this for my team automatically, which is why I like your code better. But my next question: is it better to look at the date (or a date range) in a cell and fill a shape with color based off the date range, or would it be better/easier to look at the actual color the dated cell is highlighted and tell each shape to fill itself that same color? Remember each dated cell in WS1 column C is conditionally formatted to highlight itself red, yellow, or green depending upon the date in that cell, so that "automatic" part is already done using conditional formatting.

Thanks again! Trying to learn more about ShapeRange Object in Excel, range names and how to use them, and TODAY, NOW, and EDATE!

[zmbd]

personally, I'd check the the Interior.Color property of the cell. Easier to do with named ranges.