How can I get my Macro to use re-calculated values?

[Governor]

Good afternoon all,

I am working on a Spreadsheet that will generate rectangles of a specified dimension which I can then manipulate to see if they will fit within a certain, predetermined, area. This will assist me with load planning for lorries.

I have the code worked out to create the rectangles (in different colours) but what I cannot do is amend the rectangle dimensions and have the macro resize the rectangles.

The code for the rectangles is as follows and I have attached the workbook:

Any and all help is gratefully appreciated

>>> use code - tags <<<

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Target.Worksheet.Range("D2")) Is Nothing Then
        ActiveSheet.Shapes("Boiler").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E2")) Is Nothing Then
        ActiveSheet.Shapes("Boiler").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D3")) Is Nothing Then
        ActiveSheet.Shapes("Eco Line").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E3")) Is Nothing Then
        ActiveSheet.Shapes("Eco Line").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
        ActiveSheet.Shapes("Maintenance Platform").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E4")) Is Nothing Then
        ActiveSheet.Shapes("Maintenance Platform").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D5")) Is Nothing Then
        ActiveSheet.Shapes("Boiler Control Panel").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E5")) Is Nothing Then
        ActiveSheet.Shapes("Boiler Control Panel").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D6")) Is Nothing Then
        ActiveSheet.Shapes("Continuous Regulation").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E6")) Is Nothing Then
        ActiveSheet.Shapes("Continuous Regulation").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D7")) Is Nothing Then
        ActiveSheet.Shapes("Accessories").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E7")) Is Nothing Then
        ActiveSheet.Shapes("Accessories").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D8")) Is Nothing Then
        ActiveSheet.Shapes("SCO Control Panel").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E8")) Is Nothing Then
        ActiveSheet.Shapes("SCO Control Panel").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D9")) Is Nothing Then
        ActiveSheet.Shapes("Connecting Platform").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E9")) Is Nothing Then
        ActiveSheet.Shapes("Connecting Platform").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D10")) Is Nothing Then
        ActiveSheet.Shapes("Stairs with Platform").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E10")) Is Nothing Then
        ActiveSheet.Shapes("Stairs with Platform").Width = Target.Value
    End If
   
        If Not Intersect(Target, Target.Worksheet.Range("D11")) Is Nothing Then
        ActiveSheet.Shapes("Boiler 2").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E11")) Is Nothing Then
        ActiveSheet.Shapes("Boiler 2").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D12")) Is Nothing Then
        ActiveSheet.Shapes("Eco Line 2").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E12")) Is Nothing Then
        ActiveSheet.Shapes("Eco Line 2").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D13")) Is Nothing Then
        ActiveSheet.Shapes("Maintenance Platform 2").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E13")) Is Nothing Then
        ActiveSheet.Shapes("Maintenance Platform 2").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D14")) Is Nothing Then
        ActiveSheet.Shapes("Boiler Control Panel 2").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E14")) Is Nothing Then
        ActiveSheet.Shapes("Boiler Control Panel 2").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D15")) Is Nothing Then
        ActiveSheet.Shapes("Continuous Regulation 2").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E15")) Is Nothing Then
        ActiveSheet.Shapes("Continuous Regulation 2").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D16")) Is Nothing Then
        ActiveSheet.Shapes("Accessories 2").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E16")) Is Nothing Then
        ActiveSheet.Shapes("Accessories 2").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D17")) Is Nothing Then
        ActiveSheet.Shapes("Trailer 1").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E17")) Is Nothing Then
        ActiveSheet.Shapes("Trailer 1").Width = Target.Value
    End If
   
    If Not Intersect(Target, Target.Worksheet.Range("D18")) Is Nothing Then
        ActiveSheet.Shapes("Trailer 2").Height = Target.Value
    ElseIf Not Intersect(Target, Target.Worksheet.Range("E18")) Is Nothing Then
        ActiveSheet.Shapes("Trailer 2").Width = Target.Value
    End If
   
End Sub

 

[p45cal]

It's not those cells that you're changing, it's cells in column B and C; the formulae in columns D and E which change their values but that doesn't trigger the change event. So monitor cells in colums B and C instead and get the macro to adjust the height/width using the values in cells two cells to the right of those manually changed cells. I've adjusted your macro accordingly but because it was hard work changing so many lines of code I've disabled it (by changing its name) and written another which will be easier to adjust should you move things around on the sheet, or add more rows.
The trick is to get the ShapeNames = Array("Boiler", "Eco Line", "Maintenance Platform"… line to be in the same order as the rows in RangeToMonitor. There should be at least as many entries in ShapeNames as there are rows in RangeToMonitor; it doesn't matter if there are more - they just won't be used.
The macro allows you to change more than one cell at a time: you could copy multiple cells to those columns at once, or you could select a bunch of them and press the delete key, or put the same value in some cells by selecting them, entering your value, then while holding the Ctrl key, press Enter and your value will appear in all the selected cells at once.
I've protected the sheet to protect the formulae in columns D & E, but you might prefer simply to hide columns D & E.

 

[Governor]

Good Morning,

Thank you so very much, that's incredible.

Just for clarity, the old, original code now redundant?

So if I wanted to add any additional rectangles I just add a name to the Array and increase the Range in RangetoMonitor?

 

[p45cal]

Yes & Yes.

 

[Governor]

I’m so impressed by how you’ve been able to reduce my clunky attempt at VBA into something so easily manageable and scalable!
Shows how much I have to learn…
Great work. Thanks again!

 

[Governor]

Good morning,
I was assisted with the above requirement earlier in the year and it has been suggested that it could be useful if, as well as rectangles, we could create circles too. Could this be achieved? Possibly with a drop down to offer a choice of shape?

I have attached the spreadsheet in its current from for reference.

 

[p45cal]

Possibly with a drop down to offer a choice of shape?

That's going to take me a while to code and I'm short on time at the moment, so in the attached I've

just add a name to the Array and increase the Range in RangetoMonitor

and used circles instead of rectangles. You'll be able to make them ovals too.
Also:
Formulae added to cells K2, M2, O2 and Q2
Dropdowns in cells B22:B25
Small adjustments to the code.

 

[Governor]

Incredible! Looks so simple yet effective. Thank you again!
But tell me, how does the code know whether it needs to "draw" a circular shape rather than a square/rectangle?
I consider myself to be vaguely intelligent, but as much as I try to understand the code it just doesn't translate in my head.

 

[p45cal]

how does the code know whether it needs to "draw" a circular shape rather than a square/rectangle?

It doesn't. I put the shapes on the sheet and they stay there, only when their dimensions are zero or blank you can't see them.

 

[Governor]

Genius!