Move Shape Within Range of Cell Values

Hi,

step1

add a new shape (isosceles triangle, rotation 180)

step2

move the shape

https://youtu.be/OqNSjXYc8nA

Hi,

Based on your model, open the file and press ALT+F11, this  will open the VBA window.

Select Thisworkbook, right click, view code, paste folowing:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

   Dim objShape

   Dim rngLowest        As Range, rngHighest As Range

   Dim dblSpread        As Double

   Dim dblShapePos      As Double

   Dim dblLeft          As Double

   If Target.Address <> "$D$4" Then Exit Sub

   Set objShape = ActiveSheet.Shapes(1)

   Set rngLowest = [J4]: Set rngHighest = [O4]

   dblSpread = Columns("K:N").Width

   dblLeft = Columns("K").Left

   dblShapePos = (Target - rngLowest) / (rngHighest - rngLowest) * dblSpread + dblLeft

   objShape.Left = dblShapePos - objShape.Width / 2

   Set objShape = Nothing

End Sub

Save the workbook as a .xlsm file!

User_16,

Looks like JP Ronse wants to provide code, so you can work details with him.

--

Regards,

Tom Ogilvy

Hi,

Well, you do not give very much info but have a look to this:

Paste the following code in ThisWorkbook:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

   Dim objShape As Object

   Dim intRow As Integer

   Set objShape = ActiveSheet.Shapes(1)

   If Target.Address = "$E$1" Then

      intRow = WorksheetFunction.Match([E1], Columns("A:A"), 1)

      With objShape

         .Top = Cells(intRow, "C").Top

         .Left = Cells(intRow, "C").Left

      End With

   End If

End Sub

And change the value in E1.

It is basic and just a starting point.

User_16,

About the only thing that is automatic in Excel is calculation and you can turn that off so it is also manual.

If you want something to position you shape, you would need to write a macro to manage that.

You certainly don't provide anywhere close to the details that would be needed to write such a macro.

--

Regards,

Tom Ogilvy