VBA Changing Rectange Height from Top based on cell value

[RawlinsCross]

I have several rectangles (named Rectangle 1 to Rectangle 15) all represented tank levels. On another sheet is the morning tank levels for the day corresponding to the 15 rectangles. How do I change the height of all the rectangles from the top (i.e. bottom of rectangle is anchored) based on the level shown in the cell.

RawlinsCross

 

[Momentman]

How is the data on the other sheet structured the one that shows the Tank Name and the corresponding level?

 

[Snakehips]

RawlingsCross,

Here is some illustrative code of how you might change the shape heights.
It assumes that the new values are in sheet 'New' (**Edit to suit actual**) and cells A2, A3,...... A16 and that the relationship between rectangle height (Points) and cell value (Gallons ??) is 1:10
If you put e.g. a value of 300 in cell A2, 600 in A3, 900 in A4 then it will set the first three rectangles with heights of 30 points 60 points etc.

Maybe try it out but ultimately you will need to code for both the correct source of tank values and determine the correct relationship of rectangle height to tank value.

Sub Shape_Size()
Application.ScreenUpdating = False


Set ws = ActiveSheet


For Each shp In ws.Shapes
bot = shp.Top + shp.Height
shp.Height = Sheets("New").Range("A2").Offset(ros, 0) / 10   '10 cell value units per shape height point
shp.Top = bot - shp.Height
ros = ros + 1
Next shp


End Sub

Also you may need to check that the shapes in the for she loop do loop in the expected order as this can sometimes get out of sync depending upon how the shapes have been generated / edited.

Hope that helps.

 

[RawlinsCross]

Right now, I'm using this code for the tanks and it's correctly sizing the rectangles for the tank level. My only problem is when the resizing of the rectangle occurs the rectangle moves up off the base of the tank. How can I resize the rectangle but keep its base from moving (i.e. resize from the top only).

Dim TankConS As Integer
Dim TankConSS As Integer

TankConS = Worksheets("Tank Volumes").Range("AK3").Value * 0.965
ActiveSheet.Shapes.Range(Array("Rectangle ConS")).Select
Selection.ShapeRange.Height = TankConS

TankConSS = Worksheets("Tank Volumes").Range("AL3").Value * 0.965
ActiveSheet.Shapes.Range(Array("Rectangle ConSS")).Select
Selection.ShapeRange.Height = TankConSS

 

[Snakehips]

In principle as per my post#3