Draw line from 1 cell to another

[ststern45]

Hello everyone,

First time posting. Please excuse.

My question is this:

I am trying to see if their is VBA Code for drawing a line from one cell to another.

My spreadsheet is set-up as follows:

A B C D E F G H I J K

1 # 0 1 2 3 4 5 6 7 8 9

2 5 0 1 2 3 4 5 6 7 8 9

3 8 0 1 2 3 4 5 6 7 8 9

4 6 0 1 2 3 4 5 6 7 8 9

In cell A3 is an "8". What I would like to know is if there is code that will draw a line from cell G2 to J3. Also a line from J3 to H4.

If I keep adding numbers in colum "A" I can keep adding lines. Connecting the dots if you will.

Thank you,

Steve

[mvidas]

Hi Steve,

You can use this function to draw linesFunction DrawLineBetweenCells(ByVal WS As Worksheet, ByVal Cell1 As Range, _
ByVal Cell2 As Range) As Boolean
WS.Shapes.AddLine Cell1.Left + Cell1.Width / 2, Cell1.Top + Cell1.Height / 2, _
Cell2.Left + Cell2.Width / 2, Cell2.Top + Cell2.Height / 2
End FunctionThen just use it like this to draw between cells:Sub Steve()
DrawLineBetweenCells ActiveSheet, Range("G2"), Range("J3")
DrawLineBetweenCells ActiveSheet, Range("J3"), Range("H4")
End SubLet me know if you need any modifications or have any questions!
Matt

[ststern45]

Matt,

Thanks for your reply.

Can you provide a sample file??

Thanks,

Steve

[mvidas]

Hi Steve,

I can if you still want, but if you copy/paste this, and run the "Steve" sub, it will produce a sample file for you:Sub Steve()
Application.ScreenUpdating = False
Workbooks.Add 1
ActiveWindow.DisplayGridlines = False
Columns.ColumnWidth = 1.86
DrawLineBetweenCells Range("C2"), Range("C8")
DrawLineBetweenCells Range("E2"), Range("E8")
DrawLineBetweenCells Range("C5"), Range("E5")
DrawLineBetweenCells Range("G2"), Range("G8")
DrawLineBetweenCells Range("C10"), Range("E10")
DrawLineBetweenCells Range("C10"), Range("C13")
DrawLineBetweenCells Range("C13"), Range("E13")
DrawLineBetweenCells Range("E13"), Range("E16")
DrawLineBetweenCells Range("C16"), Range("E16")
DrawLineBetweenCells Range("G10"), Range("I10")
DrawLineBetweenCells Range("H10"), Range("H16")
DrawLineBetweenCells Range("K10"), Range("M10")
DrawLineBetweenCells Range("K10"), Range("K16")
DrawLineBetweenCells Range("K16"), Range("M16")
DrawLineBetweenCells Range("K13"), Range("M13")
DrawLineBetweenCells Range("O10"), Range("O15")
DrawLineBetweenCells Range("O15"), Range("P16")
DrawLineBetweenCells Range("Q15"), Range("P16")
DrawLineBetweenCells Range("Q10"), Range("Q15")
DrawLineBetweenCells Range("S10"), Range("U10")
DrawLineBetweenCells Range("S10"), Range("S16")
DrawLineBetweenCells Range("S13"), Range("U13")
DrawLineBetweenCells Range("S16"), Range("U16")
Application.ScreenUpdating = True
End Sub
Function DrawLineBetweenCells(ByVal Cell1 As Range, ByVal Cell2 As Range) As Boolean
ActiveSheet.Shapes.AddLine Cell1.Left + Cell1.Width / 2, Cell1.Top + Cell1.Height _
/ 2, Cell2.Left + Cell2.Width / 2, Cell2.Top + Cell2.Height / 2
End FunctionI changed this to not ask you for the sheet as an argument. If you want to specify the sheet at runtime (for something other than the activesheet), you can revert to the first function above in comment #2.
If you still want a sample file, or if you have any questions, let me know!
Matt

[mvidas]

By the way, if you'd rather it use thicker lines, you can instead use:Function DrawLineBetweenCells(ByVal Cell1 As Range, ByVal Cell2 As Range) As Boolean
With ActiveSheet.Shapes.AddLine(Cell1.Left + Cell1.Width / 2, Cell1.Top + Cell1.Height _
/ 2, Cell2.Left + Cell2.Width / 2, Cell2.Top + Cell2.Height / 2)
.Line.Weight = 2.25
End With
End FunctionMatt

[lucas]

"Hi Steve"....thats cute Matt:devil:

[ststern45]

Cute.

Hi Steve

Nice!!