Solved VBA to Generate Multiple Shapes Based on Number in Cell

Microsoft Excel 2010 - complete product...
April 18, 2018 at 00:46:46
Specs: Windows 7, 2,4 GHz / 4 GB
Hello,

I made a macro to create rectangles based on cell values for a 2D excel simulation. The code below adds the shapes once per each line I have in Sheet1:

Dim r As Long, s As Shape

    For r = 3 To Sheets("Sheet1").Cells(Rows.Count, 19).End(xlUp).Row
        If Sheets("Sheet1").Cells(r, 9).Value > 0 Then
            Set s = Sheets("AUTO").Shapes.AddShape(msoShapeRectangle, 410, 10, _
            Sheets("Sheet1").Cells(r, "S"), _
            Sheets("Sheet1").Cells(r, "T"))
                s.TextFrame2.TextRange.Text = _
                  Sheets("Sheet1").Cells(r, "E") & "; D=" _
                & Sheets("Sheet1").Cells(r, "F") & "; L=" _
                & Sheets("Sheet1").Cells(r, "G") & "; " _
                & Sheets("Sheet1").Cells(r, "I") & " batches; additional pcs: " _
                & Sheets("Sheet1").Cells(r, "J")
        Else

Column 9 (I) sets the number of shapes to be created. Its values may vary from 0 to 10.

So my need would be to integrate into the code above a condition so I could add the same shape multiple times based on the value on each row in column 9.
- if value in I3 is 1, it should add 1 shape of the type in row 3
- if value in I4 is 2, it should add 2 shapes of the type in row 4 and only then move on to the next row
- and so on

Thank you in advance.

message edited by Mrrrr


See More: VBA to Generate Multiple Shapes Based on Number in Cell

Report •

#1
April 18, 2018 at 07:00:17
I'm a little confused.

As far as I can tell, the code snippet above creates rectangles based on the number of items in Range(S3:Sx). It creates a rectangle for each time there is a value in Column I of the current r Row as it loops through the Column S range.

When I test the code, it places those rectangles one on top of another, all based on the Left-410, Top-10 specification in the AddShape instruction.

Is that activity supposed continue, in addition to adding rectangles on a row by row basis or is that "piling up" something that you are trying to eliminate?

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Report •

#2
April 18, 2018 at 12:29:07
✔ Best Answer
OK, even though I'm not sure if this is what you want, I think your answer may be buried within this code.

What this does is place a bunch of small rectangles on the Auto sheet based on the values in Sheet1 Column I, S and T.

I = Count of Rectangles Per Row
S, T = Size of Rectangle (I kept this small and consistant for testing purposes)

It will place rectangles in the same row as the Column I count. e.g. if I5 = 3, there will be 3 rectangles in Row 5 on the Auto sheet. In my example, it will place the 3 rectangles in Columns I:K, 1 per column.

In order for the rectangles to be placed "neatly" in each cell, the Row height on the Auto sheet must be the default of 15 and the Column width must be the default of 8.43.

For ease of testing, I started with this on Sheet1:


        I              S        T
1
2
3       1              3        5
4       2	       3        5
5       3	       3        5
6       	       3        5
7       2	       3        5
8       5	       3        5
9       1	       3        5
10      2	       3        5
11      3	       3        5

I ended up with this (x = Rectangle)


         I       J        K        L       M  
1
2
3       x	
4       x        x	
5       x        x        x
6  
7       x        x	
8       x        x        x       x        x
9       x
10      x        x	
11      x        x        x


Here's the code I used:

Sub RecPlacer()
Dim s As Shape
Dim r As Long, h As Long, v As Long

'****************************************************
'Clear Shapes For Testing
    Sheets("AUTO").DrawingObjects.Delete      '<----------
'****************************************************
    
'Initialize Column Placement Variable (I)
    h = 346

'Initialize Rown Placement Variable (2)
    v = 20

'Loop through Column I
     For r = 3 To Sheets("Sheet1").Cells(Rows.Count, 19).End(xlUp).Row

'Increment Row Placement Variable By One Row
      v = v + 15
         
'Add Rectangles Based On Value In Column Sheet1 Collumn I
        If Sheets("Sheet1").Cells(r, 9).Value > 0 Then
          For r_count = 1 To Sheets("Sheet1").Cells(r, 9).Value
            
'Increment Column Variable By One Column
            h = h + 48.5
        
'Place Rectangles & Text
              Set s = Sheets("AUTO").Shapes.AddShape(msoShapeRectangle, h, v, _
                      Sheets("Sheet1").Cells(r, "S"), _
                      Sheets("Sheet1").Cells(r, "T"))
               
               s.TextFrame2.TextRange.Text = _
                  Sheets("Sheet1").Cells(r, "E") & "; D=" _
               & Sheets("Sheet1").Cells(r, "F") & "; L=" _
               & Sheets("Sheet1").Cells(r, "G") & "; " _
               & Sheets("Sheet1").Cells(r, "I") & " batches; additional pcs: " _
               & Sheets("Sheet1").Cells(r, "J")
          Next
        
'Reset Column Placement Variable (I)
          h = 346
        
        End If
     Next
End Sub

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

message edited by DerbyDad03


Report •

#3
April 18, 2018 at 22:16:33
Thanks for the elaborate responses.

It creates a rectangle for each time there is a value in Column I of the current r Row as it loops through the Column S range.
Yes, because since S gives me one of the dimensions I thought it would be ok to count rows by it. I thought like this because this is a code to draw shapes after all and what are shapes without dimensions?

it places those rectangles one on top of another
It does this because in sheet AUTO the rows and columns are not in their default sizes. I resized them so I could create a scale for my simulation. I had to scale the truck and the goods.

or is that "piling up" something that you are trying to eliminate?
Well, it would be nice, but as you said in your 2nd post, rectangles would be placed "neatly" if row and column sizes would be default, and they're not: row is 5 and column is 0.5. If I'd arrange them by increments of 5 they might end up piling over my truck design, which is drawn as a range border depending on tonnage, somewhere under Top-10.

I think your answer may be buried within this code.
It was, specifically the line:

For r_count = 1 To Sheets("Sheet1").Cells(r, 9).Value
I don't think I ever used r_count so far. But I'm glad to meet it.

In my example, it will place the 3 rectangles in Columns I:K, 1 per column.
It would be so nice if I could make it in such a way that I could keep default sizes for cols and rows. But I'm guessing I can't, since I want to scale down the truck to screen size. Your code is great and I will try to see how it looks with my col/row sizes.

Thanks again for your time.

message edited by Mrrrr


Report •

Related Solutions

#4
April 19, 2018 at 06:01:06
For r_count = 1 To Sheets("Sheet1").Cells(r, 9).Value
I don't think I ever used r_count so far. But I'm glad to meet it.

Don't be impressed with r_count. It's nothing more than a variable name that I made up, short for Rectangle Count. It could just have well been: MyRecCount, recs, R, r, etc.

It would be so nice if I could make it in such a way that I could keep default sizes for cols and rows.

You shouldn't have to. I guess I could have been clearer when I said: "the Auto sheet must be the default of 15 and the Column width must be the default of 8.43."

That statement is true only if the code uses h = 346, v = 20, v = v + 15, h = h + 48.5. Change those numbers to work with whatever size cells you are using and you should be all set. All I was trying to do was show the concept of placing the rectangles where you want them by setting a starting locations (h = 346, v = 20) and then coming up with an offset (v = v + 15, h = h + 48.5) for each subsequent rectangle.

Those values put the first rectangle in I3 of a sheet with default cells sizes. Change the cell sizes and also change those values to meet your needs.

Now, I'm not saying that you will actually be able to place your rectangles exactly where you want them. Even with my code, there is a bit of a shift towards the right for each rectangle. You may not notice the shift with the numbers in my example, but multiply those numbers by 20 and re-run the code. As you scroll right on the Auto sheet, you'll see the rectangles slowly shifting to the right. Maybe you can find the proper offset values that will place each rectangle exactly where you want it, but maybe not. As I'm sure you know, using Excel to simulate the loading of a truck by placing rectangles within a bordered range is, while certainly inventive, not necessarily within the scope of what the app designers had in mind. ;-)

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

message edited by DerbyDad03


Report •

#5
April 20, 2018 at 02:45:29
Yes, I know it's not what they had in mind, of course :-). And it's not even a fast enough way to use on a daily basis, with tens of truck loading operations a day. If we would have a few deliveries a week that needed this kind of work, it would be great. Or maybe not from a financial pov :-).

I just wanted to test it in principle, because I tested lots of truck loading software and I keep bashing into a wall when I have to add the additional pcs. Because the key to everything is to easily be able to simulate a truck loading and I wasn't yet able to find an application that would use a db of products (created by me in excel), then apply a set of rules to build the pallets with products from a db (also created by me), then apply some truck loading rules from a db (also created by me).

I'm not saying excel does that, but I wanted to see if I could provide the end users with a similar way a software would do. Except of course that a software simulates in 3D while my excel would sim in 2D. I thought that with the proper formulas I would be able to generate a truck (which I have), generate the pallets (which I've done with your help) and create the additional pcs somehow (to do). Then, I must think of some formulas to set truck loading rules.

It might get me nowhere, but it also might get me somewhere.

Thank you for all the help on this matter (and on all the others I had)!


Report •

Ask Question