Move a shape based on Cell value. If cell is less than another shape moves up, if cell is more than another cell moved down.

[Tfelsbo]

Hi I am trying to get a shape to move based on a cell value.

If cell "V19" is a higher value than and "I21" I want the shape to move slightly up, then do the exact opposite when "V19" is of lower value than "I21" I want the shape to move back to its original position.

Does anyone know how to do this I have tried a few different things, but my VBA skills are not that great.

 

[jolivanes]

To just move it, as you call it, slightly up or down.

Name the shape PUMP.
Change Sheet name to actual Sheet name.

Sub Move_Down()
    Sheets("Sheet1").Shapes("PUMP").Top = Sheets("Sheet1").Shapes("PUMP").Top + 1
End Sub

Sub Move_Up()
    Sheets("Sheet1").Shapes("PUMP").Top = Sheets("Sheet1").Shapes("PUMP").Top - 1
End Sub

If you want to restrict how high or deep the pump can go, you have to let us know and in relation to what.

To move to it's original, we need to know the restrictions and what is the original. Once it has moved, the original is disappeared unless you want to keep track, with code, all the top positions.

 

[jolivanes]

Or put this in the Sheet module where your 2 cells that are compared are and where the PUMP is.
It'll go up or down as you change either cell.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target = Cells(19, 22) Or Target = Cells(21, 9) Then
        If Cells(19, 22).Value > Cells(21, 9).Value Then
            Sheets("Sheet1").Shapes("PUMP").Top = Sheets("Sheet1").Shapes("PUMP").Top + 1
                Else
            Sheets("Sheet1").Shapes("PUMP").Top = Sheets("Sheet1").Shapes("PUMP").Top - 1
        End If
    End If
End Sub

 

[Tfelsbo]

Hi thanks for your reply. A great help thanks you.

To just move it, as you call it, slightly up or down.

Name the shape PUMP.
Change Sheet name to actual Sheet name.

Sub Move_Down()
    Sheets("Sheet1").Shapes("PUMP").Top = Sheets("Sheet1").Shapes("PUMP").Top + 1
End Sub

Sub Move_Up()
    Sheets("Sheet1").Shapes("PUMP").Top = Sheets("Sheet1").Shapes("PUMP").Top - 1
End Sub

If you want to restrict how high or deep the pump can go, you have to let us know and in relation to what.

To move to it's original, we need to know the restrictions and what is the original. Once it has moved, the original is disappeared unless you want to keep track, with code, all the top positions.

Yeah, I do want to limit its movement as currently If I enter a lower number twice the shape just keeps moving upwards and the same in the downwards direction.

I want the shape/pump to go no lower than cell (22,18) and no lower than cell (16,18).
Current code is below

Private Sub Worksheet_change(ByVal Target As Range)

'Run this code when Cell is changed

If Target = Cells(16, 9) Or Target = Cells(36, 9) Then

If Cells(16, 9).value > Cells(36, 9).value Then


    Sheets("Diagram").Select
    ActiveSheet.Shapes.Range(Array("pump")).Select
    Selection.ShapeRange.IncrementTop -35.3911811024

Else

    Sheets("Diagram").Select
    ActiveSheet.Shapes.Range(Array("pump")).Select
    Selection.ShapeRange.IncrementTop 35.1305511811

    End If
    
End If

End Sub

Cheers

 

[Tfelsbo]

Ok all good.

I have sorted it!

Thanks for your help jolivanes. You have saved me a tone of time.

Private Sub Worksheet_change(ByVal Target As Range)



'Run this code when Cell is changed

If Target = Cells(16, 9) Or Target = Cells(36, 9) Then

If Cells(16, 9).value > Cells(36, 9).value Then


    Sheets("Diagram").Select
    ActiveSheet.Shapes("pump").Top = Cells(16, 17).Top

   
Else

    Sheets("Diagram").Select
    ActiveSheet.Shapes("pump").Top = Cells(18, 17).Top
    

 End If
    
End If


End Sub

 

[jolivanes]

Good to hear that you have it all sorted.
However, I don't think you need the Sheets("Diagram").Select lines.
I am assuming that the code needs to be fired when changing values in that sheet and that the code is in the Sheet Module for Sheet "Diagram".
Minimize select, selecting, activate etc as much as you can. As a matter of fact, it is seldom required.