Multiple Macros (Excel) 1

[Twaddle]

I am trying to use the code below many times to conditionally colour auto shapes but I don't know how to alter this to reference another cell and change another shape. I have tried just copying and pasting the whole routine again and changing it's name and the cell and shape names but that doesn't work.

Does anyone have any ideas?

Thanks


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("fred")) Is Nothing Then Exit Sub

Me.Shapes("bert").Select
With Range("fred")
If .Value > 0 And .Value <= 56 Then
Selection.ShapeRange.Fill.ForeColor.RGB = ThisWorkbook.Colors(.Value)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = 0
End If
.Select
End With



End Sub

 

[SkipVought]

Hi,

This code has Shape "Bert" associated with Range "Fred".

What other Shape/Range associations do you have on your sheet?

I'd suggest putting that into a table, like...
[tt]
ShpName RngName
[/tt]


Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Twaddle]

Skip, I was just looking for an example of how to code it. I have plenty of shapes which I would like to link to cells, if you could just provide a sample of the code e.g.
range Fred - Shape Bert
range A - Shape B
range C - Shape D

That would be GREAT!

Thanks

 

[SkipVought]

I was just looking for an example of how to code it.

Isn't that what you already have?

Please explain what you want to happen under what conditions.

For instance, in the code you posted, each time the value in range "fred" is changed, the shape "bert" is conditionally shaded, based on a certain range of values and with a shade base on the value in "fred".



Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Twaddle]

Skip, Thanks for your reply. The problem I have is how to colour more than one object. I know nothing really about coding but try to modify things that the MACRO recorder generates or as in this case a piece of code I found by Googling. I have tried copying the code and giving the private sub a different name but that doesn't work and as I tried to inidicate earlier I have a number of shapes that I want to colour differently by just changing numbers in cells.

I hope that explains thing better.

Thanks for taking your time to help me.

 

[SkipVought]

Make a table
[tt]
RngName ShpName
Fred Bert
A B
C D
[/tt]
Name the ranges using Insert > Name > Create names - Create names in TOP row. When you select RngName in the Name Box, you should see the cells below RngName selected. No SPACES in names.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    
    For Each r In [RngName]
        If Not Intersect(Target, Range(r.Value)) Is Nothing Then
            ActiveSheet.Shapes(Range("ShpName")(r.Row - 1)).OLEFormat.Object.Interior.ColorIndex = Target.Value
        End If
    Next
End Sub

tested.


Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[combo]

Shapes are one of few things that can be changed by UDF. It is possible to change autoshape type, colour, colour index, size, position, and visibility. The price is just one cell per shape. So you can create a custom function, with shape name as one of arguments, and the rest as necessary shape settings, an example:

Public Function ChangeShape(ShapeName As String, ShapeType As MsoAutoShapeType, Visible As Boolean, Color)
Application.Volatile
Dim shX As Shape
Set shX = Application.ThisCell.Parent.Shapes(ShapeName)
With shX
    .AutoShapeType = ShapeType
    .Visible = Visible
    .Fill.ForeColor.RGB = Color
    ' other required settings
End With
ChangeShape = Visible
End Function

It's fun to see shapes moving, changing size, colours or visibility by single function.


combo

 

[SkipVought]

The OP has failed to describe exactly WHAT he/she wants to happen under what conditions.

I coded a solution that triggers on a cell change, modeled after the posted example.

There are so many other possibilities, but until the OP states what they want, it's kind of difficult to anticipate their need.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Twaddle]

Combo & Skip - sorry guys I don't get either of your solutions.
Skip I have column headings correct and shapes correctly named. If select the range from the drop down goto box then the correct range is highlighted.
The VB hihglight 'ActiveSheet.Shapes(Range("ShpName")(r.Row - 1)).OLEFormat.Object.Interior.ColorIndex = Target.Value' as the problem but no idea why.

Sorry to be a pain.

Any thoughts - Thanks

 

[Twaddle]

Skip - Not sure what I have done but I now have it working

THANKS!!