0 votes
in VBA by Beginner (10 points)

Hello, I found your post: https://wellsr.com/vba/2015/excel/draw-lines-or-arrows-between-cells-with-vba/
And i beleive this will work for what i'm trying to do..

I need help moving an arrow shape in my worksheet.

My Workbook has 2 Sheets:
One is a Grid to display the users Current and Projected Retirement Percentage.
The other is a Setup-sheet where the user enters their (Birth Date, Hire Date, Current Hourly Wage, Planned Retirement Date).

When the User enters their info in the Setup sheet, and then Click on the Grid Sheet it displays a Grid with Age along the Top and Years of Service down the Left.

Arrow Demo

Screenshot above..
I'm using Conditional Formatting to Highlight the users Current Percentage and Retirement Percentage. with their Current and Retirement data shown to the right of the Grid.

If the Insert Image via URL worked above, you can see the Blue and Green Arrows that I want to work with.
I would like to have the Right or Beginning of the Arrow to be Anchored, and the Left or Pointer of the Arrow to Move around to follow the Highlighted Blue and Green Cells as the data changes in the Setup sheet..

I hope I have explained this well, and I hope the Insert Image via URL worked..


1 Answer

0 votes
by Super Expert (3.2k points)
selected by
Best answer

To do this, you'll need to open your VBA editor and double-click the worksheet you're interested in on your Project Pane. The sheets are listed under Microsoft Excel Objects:

From here, you'll want to capture any calculation changes that could cause the conditional formatting to trigger. I just checked for every calculation on the sheet in the macro below. Go ahead and paste this macro into the sheet object:

Private Sub Worksheet_Calculate()
Dim cell As Range, currSel As Range
Set currSel = Selection
'delete existing arrows
Call DeleteArrows
'determine conditionally highlighted cell then draw arrows
For Each cell In ActiveSheet.UsedRange
    If cell.DisplayFormat.Interior.color = RGB(189, 215, 238) And cell.DisplayFormat.Font.color = vbRed Then
        'can change the conditional formula interior color above to match the
        'exact RGB color of your conidtionally formatted cells.
        Call DrawArrows(Range("T11"), cell, RGB(73, 118, 197)) 'DARKER BLUE ARROW
    ElseIf cell.DisplayFormat.Interior.color = RGB(169, 208, 142) And cell.DisplayFormat.Font.color = vbRed Then
        'can change the colors here, too
        Call DrawArrows(Range("T15"), cell, RGB(111, 172, 69)) 'DARKER GREEN ARROW
    End If
Next cell
End Sub

Private Sub DrawArrows(FromRange As Range, ToRange As Range, Optional RGBcolor As Long)
'---Script: DrawArrows-------------------------------------------------------------------------------
'---Created by: Ryan Wells (wellsr.com) -------------------------------------------------------------
'---Original Source: https://wellsr.com/vba/2015/excel/draw-lines-or-arrows-between-cells-with-vba/ -

Dim dleft1 As Double, dleft2 As Double
Dim dtop1 As Double, dtop2 As Double
Dim dheight1 As Double, dheight2 As Double
Dim dwidth1 As Double, dwidth2 As Double
dleft1 = FromRange.Left
dleft2 = ToRange.Left
dtop1 = FromRange.Top
dtop2 = ToRange.Top
dheight1 = FromRange.Height
dheight2 = ToRange.Height
dwidth1 = FromRange.width
dwidth2 = ToRange.width
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, dleft1, dtop1 + dheight1 / 2, dleft2 + dwidth2, dtop2 + dheight2 / 2).Select
'format line
With Selection.ShapeRange.Line
    .BeginArrowheadStyle = msoArrowheadNone
    .EndArrowheadStyle = msoArrowheadTriangle
    .Weight = 1.75
    .Transparency = 0
    'color arrow
    If RGBcolor <> 0 Then
        .ForeColor.RGB = RGBcolor 'custom color
        .ForeColor.RGB = RGB(228, 108, 10)   'orange (DEFAULT)
    End If
End With
End Sub

Sub DeleteArrows()
    For Each shp In ActiveSheet.Shapes
        If shp.Connector = msoTrue Then
        End If
    Next shp
End Sub

In this example, I look for any cells in the used range that were conditionally formatted with a blue background and red text. You can change the RGB functions to match your specific colors. I then draw a line from the left side (centered vertically) of cell T11 to the right side (centered vertically) of all the blue cells. I do the same for green cells, but I start the line from T15. You can adjust the starting position in the Worksheet_Calculate routine, as well.

The screenshot below demonstrates the behavior on a sample spreadsheet I put together:

Hopefully this will point you in the right direction!

by Beginner (10 points)

HA!!!  Holly Smokes..  You Fricken Rock..

That works right from the Start. I just adujsted the Start Cells to T10 and T16.

And then I added a Worksheet_Activate, and now when I edit the Data on the Setup Sheet, and then Click back on the "Grid" sheet, it runs Worksheet_Calculate and draws the Arrows..

Private Sub Worksheet_Activate()
Call Worksheet_Calculate
End Sub


Thank You Ryan..

by Super Expert (3.2k points)
Haha that's great! I'm really happy to hear it worked!

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

ParserMonster $25 Amazon Gift Card
Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.


For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.