Question

Here’s what I want to do and I really don’t know how to do it or if it is possible.
I have one column where some values are generated. Let’s say the column number is 10.
What I want to do… if the value of a cell in that column is > 1 I want to draw a rectangle (in the next cell or close to that cell) (column 11 same row) with a macro assigned to it.
The macro will insert another row right after that one where the cell is and where the rectangle will be drawn so I have to get somehow the position of the rectangle.
Any ideas?
Thanks a lot!

Answer 1

Sub Tester()
Dim c As Range

    For Each c In ActiveSheet.Range("A2:A30")
        If c.Value > 1 Then
            AddShape c.Offset(0, 1)
        End If
    Next c

End Sub


Sub AddShape(rng As Range)
    With rng.Cells(1).Parent.Shapes.AddShape(msoShapeRectangle, rng.Left, _
                                    rng.Top, rng.Width, rng.Height)
        .OnAction = "DoInsertAction"
    End With
End Sub

Sub DoInsertAction()
    Dim r As Long
    r = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
    ActiveSheet.Rows(r + 1).Insert Shift:=xlDown
End Sub