Drawing with loop, loop help!

[mlcs]

Hi!

I new to VBA programming.... so sorry about my ignorence...

I've made the following code which draws a time diagram, each step
containing three lines. Manual labor, machine time and movement. So far
it's working well, Step 1 starts in H11 and depending on the values in
E11, F11 and G11 step 1 draws two horizontal lines and a diagonal.
First manual, then machine, and finally it draws movement - if movement
= 0 then it draws a horizontal line to the row below, else it draws a
diagonal line.

What I need:
Instead of having 50 steps I need it to take one step and loop (because
I have everything between 20-50 steps).
I need it to reed the values:
E11, F11, G11 (if all = 0 the stop looping, else move on to
E12, F12, G12

I hope some you can help.....

Thank you..... Martin

'Step 1
'manual
X1 = Range("H11").Left
X2 = X1 + (Range("E11") * (Range("H11").Width / Range("H9")))
Y1 = Range("H11").Top + Range("H11").Height / 2
ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y1).Select

'machine
X3 = X2 + (Range("F11") * (Range("I11").Width / Range("H9")))
ActiveSheet.Shapes.AddLine(X2, Y1, X3, Y1).Select
Selection.ShapeRange.Line.DashStyle = msoLineDash

'movement
X4 = X2 + (Range("G11") * (Range("I11").Width / Range("H9")))
Y2 = Y1 + Range("H11").Height
ActiveSheet.Shapes.AddLine(X2, Y1, X4, Y2).Select
Selection.ShapeRange.Line.DashStyle = msoLineRoundDot

'Step 2
'manual
X5 = X4 + (Range("E12") * (Range("H12").Width / Range("H9")))
ActiveSheet.Shapes.AddLine(X4, Y2, X5, Y2).Select

'machine
X6 = X5 + (Range("F12") * (Range("H12").Width / Range("H9")))
ActiveSheet.Shapes.AddLine(X5, Y2, X6, Y2).Select
Selection.ShapeRange.Line.DashStyle = msoLineDash

'movement
X7 = X5 + (Range("G12") * (Range("H12").Width / Range("H9")))
Y3 = Y2 + Range("H12").Height
ActiveSheet.Shapes.AddLine(X5, Y2, X7, Y3).Select
Selection.ShapeRange.Line.DashStyle = msoLineRoundDot

.... and so on.

 

[Guest]

Sub DrawLines()
Dim rng as Range, E as Range, E as Range
Dim G as Range, H as Range, I as Range
Dim cell as Range
With Activesheet
set rng = .Range(.Range("E11"),.Range("E11").End(xldown))
End With
for each cell in rng
set E = cell
set F = cell.offset(0,1)
set G = cell.offset(0,2)
set H = cell.offset(0,3)
set I = cell.offset(0,4)
X1 = H.Left
X2 = X1 + (E * H.Width / Range("H9")))
Y1 = H.Top + H.Height / 2
ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y1).Select

'machine
X3 = X2 + (F * I.Width / Range("H9")))
ActiveSheet.Shapes.AddLine(X2, Y1, X3, Y1).Select
Selection.ShapeRange.Line.DashStyle = msoLineDash

'movement
X4 = X2 + (G * (I.Width / Range("H9")))
Y2 = Y1 + H.Height
ActiveSheet.Shapes.AddLine(X2, Y1, X4, Y2).Select
Selection.ShapeRange.Line.DashStyle = msoLineRoundDot
Next

End sub

 

[Guest]

hi martin

tried to do something, should work!
gimme some feedback if everythings fine!
'-----------------------------------------------
Sub martin()

Dim X1, X2, Y1, Y2, XTemp As Single
Dim cell_ As Integer

X2 = Range("H11").Left
cell_ = 11

Do While ActiveSheet.Range("E" & cell_) <> "" And ActiveSheet.Range("G" &
cell_) <> "" And ActiveSheet.Range("F" & cell_) <> ""
For I = o To 2
X1 = X2
Y1 = Range("H" & cell_).Top + Range("H" & cell_).Height / 2
If I < 2 Then
Y2 = Y1
XTemp = X1
X2 = X2 + (Cells(cell_, 5 + I) * (Range("H" & cell_).Width /
Range("H9")))
ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Select
Else
Y2 = Y1 + Range("H" & cell_).Height
X2 = XTemp + (Cells(cell_, 5 + I) * (Range("H" & cell_).Width /
Range("H9")))
ActiveSheet.Shapes.AddLine(XTemp, Y1, X2, Y2).Select
End If
Selection.ShapeRange.Line.DashStyle = Choose(I + 1, msoLineSolid,
msoLineDashDot, msoLineRoundDot)

Next I
cell_ = cell_ + 1
Loop
End Sub
'------------------------------------------------
Cheers and a nice weekend
Carlo