Excel Question

[Winalot2007]

Is it possible to create VBA code that will draw an arrow from one cell to another based on the value of each of the cells.

In cell range z1 through bl1. Only one cell in this range will have a value of 3. EG cell aa1=3

In cell range z2 through bl2. Only one cell in this range will have a value of 3.
ae2=3

I would like to connect ae1 with aa1 with an arrow.

I realize you can use the drawing toolbar to connect cells. I have 100 lines and after every draw the 100 cells will change values.

Thanks!!!

 

[GillesD]

Drawing an arrow between two cells

The VBA code ActiveSheet.Shapes.AddLine will draw a line on the active sheet (and you can then transform it into an arrow). You must pass the X,Y coordinates of the starting point and the X,Y coordinates of the end point as parameters.

So if you can determine the specific coordinates of the cell you want the arrow to start and the coordinates of the end cell, you are in business. But this is not as easy as it seems since these values will depend on many, many factors (configuration, height, width, etc.).

 

[time*treat]

may want to re-indent

Sub NumMatchArrow()
'By time*treat'
Dim targ As Integer, dest As Integer
Const targ__row As Integer = 1
Const dest__row As Integer = 2
Dim targ__col As Integer, dest__col As Integer
Dim targ__val As Integer, dest__val As Integer
Dim x1 As Integer, x2 As Integer
Dim y1 As Integer, y2 As Integer

targ__val = 15 'example ~ number sought'
x1 = 0: x2 = 0
y1 = (Cells(targ__row, 1).RowHeight) / 2
y2 = y1 + Cells(dest__row, 1).RowHeight

For targ__col = 1 To 256 'max cols'
If Cells(targ__row, targ__col).Value = targ__val Then
x1 = Cells(targ__row, targ__col).Left + Cells(targ__row, targ__col).Width / 2
For dest__col = 1 To 256 'max cols'
If Cells(dest__row, dest__col).Value = targ__val Then
x2 = Cells(dest__row, dest__col).Left + Cells(dest__row, dest__col).Width / 2
ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Line.EndArrowheadLength = msoArrowheadLengthMedium
Selection.ShapeRange.Line.EndArrowheadWidth = msoArrowheadWidthMedium
Exit For
End If
Next dest__col
Exit For
End If
Next targ__col
End Sub

 

[GillesD]

Drawing lines - Example

Using the bottom right corner of the starting cell and the top left corner of the ending cell, the following code will join cell A1 to E6 and cell A6 to E13:
- ActiveSheet.Shapes.AddLine(63, 29, 255, 74).Select
- ActiveSheet.Shapes.AddLine(63, 75, 255, 180).Select
on my system when cell's width is 10 and row's height is 15.

But to join the same cells when the cell's width is 6 and row's height is 20, I have to use the code:
- ActiveSheet.Shapes.AddLine(39, 19, 160, 98).Select
- ActiveSheet.Shapes.AddLine(39, 117, 160, 235).Select

This was obtained using the Record macro feature. All values are rounded and more or less precise (±1 unit) as it is difficult to hit precisely on a corner, although using a 200% zoom factor helps.

Knowing the width and the height of cells (in units), then where you want a line to start and end, will allow you to determine the parameters to pass to the AddLine command.