Creating blocks with VBA

[Peter Davison]

Hi
I have this code below for creating blocks based on two main cells E1 and E2 (e.g. E1 = 9 and E2 = 120) so the code will replicate 9 blocks of 120cm width plus the pre determined permanent height.
It then loops until it has completed the 9
What I want to change is -
Instead of it looking at E2 for the width I want it to start the first of the 9 (or whatever figure is in E1 looking at the width in Cell T4 and use each width in the cells T4 through to where the figure ends (in this case it would be AB4 (because it is 9 bays). This is because odd cell widths may be different.
I'm struggling to see what I would change in the code.
If anyone could help I would appreciate your time.

Another option if easier would be to ignore Cell E1 altogether and just use cells filled in from T4 onwards as the count

This is what it looks like on the sheet

 

[Snakehips]

@Peter Davison Cannot see your code!!

 

[Peter Davison]

Sorry, I was not able to use addin XL2BB, I had it before and it affected some of my files to had to take it off.
Did you see the copy of the spreadsheet pic?
This is my code

Private Sub CommandButton1_Click()
'Add a fixture

Dim s As Shape
Dim k9 As Range
Dim k17 As Range
Dim i As Integer
Dim k As Integer
Dim sleft As Integer
Dim sWidth As Variant
Dim nb As Variant
Dim ws As Worksheet
Set ws = Sheets("sheet1")

Const sHeight As Integer = 210

Set sWidth = ws.Range("e2")
Set nb = ws.Range("e1")
Set k9 = ws.Range("K9")
Set k17 = ws.Range("K17")


For i = 0 To nb - 1

sleft = k9.Left + (i * sWidth)


'add a shape
'Positions (type of shape, Start Position from left, Start Position from Top, Width, Height)
Set s = ws.Shapes.AddShape(1, sleft, k9.Top, sWidth, sHeight)
s.Line.Weight = 2.5



'make the fixture Black
s.Fill.ForeColor.RGB = RGB(0, 0, 0)
s.Line.ForeColor.RGB = RGB(0, 0, 0)

s.Fill.Visible = False

Next i

For k = 0 To nb - 1

sleft = k17.Left + (k * sWidth)


'add a base
'Positions (type of shape, Start Position from left, Start Position from Top, Width, Height)
Set s = ws.Shapes.AddShape(1, sleft, k17.Top, sWidth, 23)

'make the base Black
s.Fill.ForeColor.RGB = RGB(0, 0, 0)
s.Line.ForeColor.RGB = RGB(0, 0, 0)


Next k



End Sub

 

[Snakehips]

Give this a try.

Private Sub CommandButton1_Click()
'Add a fixture

Dim s As Shape
Dim k9 As Range
Dim k17 As Range
Dim i As Integer
Dim k As Integer
Dim sleft As Integer
Dim sWidth As Variant
Dim nb As Variant
Dim ws As Worksheet
Set ws = Sheets("sheet1")

Const sHeight As Integer = 210


'Set nb = ws.Range("e1")   '<<<<  **************  No longer needed ?
Set k9 = ws.Range("K9")
Set k17 = ws.Range("K17")

'********** nb = column last width data entry in in row 4 - 19 since first width is in column 20
nb = Cells(4, Columns.Count).End(xlToLeft).Column - 19

sleft = k9.Left   '******************
'*********************
If nb < 1 Then
MsgBox "No width dat !   Please try again."
Exit Sub
End If
'***********************

For i = 0 To nb - 1
sWidth = ws.Range("t4").Offset(0, i)  '***************'Width as per Detail in row 4

'add a shape
'Positions (type of shape, Start Position from left, Start Position from Top, Width, Height)
Set s = ws.Shapes.AddShape(1, sleft, k9.Top, sWidth, sHeight)
s.Line.Weight = 2.5

'make the fixture Black
s.Fill.ForeColor.RGB = RGB(0, 0, 0)
s.Line.ForeColor.RGB = RGB(0, 0, 0)

s.Fill.Visible = False

sleft = sleft + sWidth  '******************

Next i

sleft = k9.Left   '******************
For k = 0 To nb - 1

sWidth = ws.Range("t4").Offset(0, k)  '***************  Width as per Detail in row 4

'add a base
'Positions (type of shape, Start Position from left, Start Position from Top, Width, Height)
Set s = ws.Shapes.AddShape(1, sleft, k17.Top, sWidth, 23)

'make the base Black
s.Fill.ForeColor.RGB = RGB(0, 0, 0)
s.Line.ForeColor.RGB = RGB(0, 0, 0)
sleft = sleft + sWidth     '****************

Next k

End Sub

 

[Peter Davison]

For i = 0 To nb - 1 sWidth = ws.Range("t4").Offset(0, i) '***************'Width as per Detail in row 4 'add a shape 'Positions (type of shape, Start Position from left, Start Position from Top, Width, Height) Set s = ws.Shapes.AddShape(1, sleft, k9.Top, sWidth, sHeight) s.Line.Weight = 2.5 'make the fixture Black s.Fill.ForeColor.RGB = RGB(0, 0, 0) s.Line.ForeColor.RGB = RGB(0, 0, 0) s.Fill.Visible = False sleft = sleft + sWidth '****************** Next i

Hi,
In the loop above it just kept going until error instead of stopping at the last entry (9th one in this instance in cell AB4)
Any thoughts?
Thanks for your time

 

[Snakehips]

I can only think that you have cells in row 4 , column T and to the right, that look empty but are not actually empty. Eg contain a space.
Do a clear contents on row 4. At least T >>. and see if its ok

To test, rather than rum the code with your button, step through the code, line by line, from within the vba editor by using F8 key.
Then, immediately after the nb = cells(4,........ line you can hover the cursor on nb and see what it's value is. If as per your example, it should be 9 and all should be good.
If not good then do a reset to avoid running the balance of the code.
If not then we need to look a bit deeper.

 

[Peter Davison]

Your brilliant!
There was something on row 4 further to the right.
I moved it and all ran perfectly.
Thank you so much for all you help.
Its such a great site for help.
All the best

 

[Snakehips]

Your brilliant!
There was something on row 4 further to the right.
I moved it and all ran perfectly.
Thank you so much for all you help.
Its such a great site for help.
All the best

You are most welcome!