Excel to Shapes

[johnsending]

Hello All,

Through searches int his forum, I was able to use an Excel VBA code to produce shapes on another worksheet per Cell Value. Everything seems to work perfectly but the shapes are side-by-side. Is there a way to have the first to cell value shapes on top and the others in the bottom displaying a line to what they are connected to?
Example:
Excel Worksheet "Switch-List":
Column Name Loc-Connect Des-Name Des-Connect
Row1 X1-1-A 1-A-1 E1-2-1 1\Z\1
Row2 Z2-1-A 1-A-1 E1-2-1 1\Z\4
Row3 X1-1-A 1-A-2 E1-9-1 1\Z\1
Row4 Z2-1-A 1-A-2 E1-9-1 1\Z\2


Note: Loc-Connect = Local Connection & Des-Name\Connect = Destination Name \ Connection


The Current VBA code displays on worksheet as shapes: [X1-1-A][Z2-1-A][E1-2-1][E1-9-1]


I would like to have it displayed as (Cross-Connections don't look so good):
[X1-1-A] [Z2-1-A]
| - - |
| ------ |
[E1-2-1] -- --[E1-9-1]


I'm not very knowledgeable on formatting in VBA so any suggestions or assistance is highly appreciated.
Thank you,
John

 

[johnsending]

Of course, it would help to supply the code that I'm using. Sorry forgot to add it:

Option Explicit
Sub main()
Dim referencedList As Range
Set referencedList = ThisWorkbook.Sheets("Switch-List").Range("A2:A500")
Sample referencedList
End Sub
Sub Sample(referencedList As Range)
Dim shp As Shape
Dim oneCell As Range
Dim leftValue As Long
Const topValue As Integer = 50
Const widthValue As Integer = 150
Const heightValue As Integer = 25
leftValue = 0
For Each oneCell In referencedList.Cells
If oneCell.Value = "" Then _
GoTo continue
Set shp = ActiveSheet.Shapes.AddShape( _
msoShapeRectangle, leftValue, topValue, widthValue, heightValue)

With shp.OLEFormat.Object
.Formula = ""
.ShapeRange.ShapeStyle = msoShapeStylePreset41
.ShapeRange(1).TextFrame2.TextRange.Characters.Text = oneCell.Value
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter

End With
leftValue = leftValue + widthValue
continue:
Next oneCell
End Sub