Interesting visualization idea

**Ferloft** · 06-27-2013, 09:26 AM

So here is my idea, just wondering if it is possible.

So say cell B1 has a value of 10. Now my idea is for cell B2 to have a marker that shows where the value of B1 falls on a scale.

For instance:
Capture.JPG
(just so you can understand what im getting at)

If this is at all possible I could apply it to a project I am currently working on. If not, it was a good idea

**ragulduy** · 06-27-2013, 09:40 AM

Dont see why you couldn't do that. Draw the shape/use a picture and then move it as neccessary. The minimum value would be:

Range("B2").left

and the maximum value would be

Range("B2").left + Range("B2").width

so the position of the centre of the slider would be

Range("B2").left+((Range("B2").left+Range("B2").width)/20)*Range("B1").value

I guess you would need to subtract half of the slider width and then assign that formula to the slider.left property (where slider is a variable assigned to your shape/picture)

**Ferloft** · 06-27-2013, 09:56 AM

What would the code be to assign slider to the shape?

**ragulduy** · 06-27-2013, 09:58 AM

Set Slider = Sheets("Sheet Name").Shapes("Shape Name")

or you could use:

Sheets("Sheet Name").Shapes("Shape Name").left = Range("B2").left+((Range("B2").left+Range("B2").width)/20)*Range("B1").value

instead

**Ferloft** · 06-27-2013, 10:09 AM

I have this

slider = Sheets("Sheet1").Shapes("Flowchart: Sort 1")

but I get the error "Object doesn't support this property or method"

Sorry if I'm slow, never used excel shapes before

**ragulduy** · 06-27-2013, 10:11 AM

You need

set slider = Sheets("Sheet1").shapes("Flowchart: Sort 1")

**Norie** · 06-27-2013, 10:20 AM

Try this, which goes in the worksheet module, which can be accessed by right clicking the worksheet tab and selecting View Code.


Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Row = 1 And Target.Column = 2 Then
        Me.Shapes("FlowChart: Sort 1").Left = Target.Offset(1).Left + Target.Offset(1).Width / (Target.Offset(1, 1) - Target.Offset(1, -1)) * Target.Value
    End If
End Sub

It's only set up for B1/B2 but could be adapted if you have a row of these shapes as in the image.

**Andy Pope** · 06-27-2013, 10:45 AM

non coded approach.

would need more work if the min/max values change radically

**Ferloft** · 06-27-2013, 10:46 AM

Here is what I have come up with:

Sub Macro1()

Set slider = Sheets("Sheet1").Shapes("Flowchart: Sort 1")
LeftPos = Range("F5").Left
RightPos = Range("F5").Left + Range("F5").Width
Value = Range("G3").Value
If Value < Range("E5").Value Or Value > Range("G5").Value Then
    ActiveSheet.Shapes.Range(Array("Flowchart: Sort 1")).Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Line.Visible = msoFalse
    GoTo EndSub
Else
    ActiveSheet.Shapes.Range(Array("Flowchart: Sort 1")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End If
Position = LeftPos + ((Value - Range("E5").Value) / (Range("G5").Value - Range("E5").Value)) * (RightPos - LeftPos)
slider.Height = Range("F5").Height
slider.Top = Range("F5").Top
slider.Left = Position - (0.5 * slider.Width)
EndSub:
Range("G3").Select
End Sub

It is set to automatically run when G3 is selected. E5 and G5 are the min and max.

Another cool idea would be to create a color gradient that changes the slider depending on position. I think this would be similar to finding the position but it seems a bit daunting for me.