Create a block diagram from text

[AleemAM123]

Hi Everyone,

I was wondering, is it possible to create a block diagram from a list?

The list shows a column that is the source of flow and the second column is where that flow is going to. The third and fourth column shows the units and quantity. I have drawn what the diagram should look like in the attached spreadsheet.

Visio would have been a good program to use but I am lost in visual basic in that that program, it used to be able to import the data and do it automatically but that functionality was lost when Microsoft released later versions. The plus in excel is that I can use the cells for calculations.

Anyway, if you have any suggestions, I'd like to hear it, thanks.

[Bob Phillips]

Public Sub BuildBlockDiagram()
Const RectTop As Long = 100
Const RectLeft As Long = 200
Const RectSide As Long = 75
Const LabelHeight As Long = 18
Dim shpRect As Shape
Dim shpLine As Shape
Dim shpLabel As Shape
Dim Lastrow As Long
Dim VerticalIdx As Long
Dim HorizontalIdx As Long
Dim VerticalOff As Long
Dim ArrowIdx As Long
Dim ArrowOff As Double
Dim i As Long

With ActiveSheet

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set shpRect = .Shapes.AddShape(msoShapeRectangle, RectLeft, RectTop * 2, RectSide, RectSide)
shpRect.TextFrame.Characters.Text = .Cells(2, "A").Value
shpRect.Name = .Cells(2, "A").Value
For i = 2 To Lastrow

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

VerticalIdx = 1
Else

VerticalIdx = VerticalIdx + 1
End If

If .Cells(i, "B").Value = .Cells(i - 1, "B").Value Then

VerticalOff = 10
ArrowIdx = .Evaluate("COUNTIF(B2:B" & i & ",B" & i & ")")
Else

VerticalOff = 0
ArrowIdx = .Evaluate("COUNTIF(B2:B" & i & ",B" & i & ")")
ArrowOff = RectSide / (.Evaluate("COUNTIF(B2:B" & Lastrow & ",B" & i & ")") + 1)
VerticalIdx = .Evaluate("SUMPRODUCT((A2:A" & i & "=A" & i & ")/COUNTIF(B2:B" & i & ",B2:B" & i & "))") 'SUMPRODUCT(1/COUNTIF(B2:B" & i & ",B2:B" & i & "))")
HorizontalIdx = .Evaluate("SUMPRODUCT(1/COUNTIF(A2:A" & i & ",A2:A" & i & "))")
Set shpRect = .Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=RectLeft * (HorizontalIdx + 1), _
Top:=.Shapes(.Cells(i, "A").Value).Top + RectTop * (VerticalIdx - 1), _
Width:=RectSide, _
Height:=RectSide)
shpRect.TextFrame.Characters.Text = .Cells(i, "B").Value
shpRect.Name = .Cells(i, "B").Value
End If

Set shpLine = .Shapes.AddLine(BeginX:=.Shapes(.Cells(i, "A").Value).Left + RectSide, _
BeginY:=.Shapes(.Cells(i, "A").Value).Top + RectSide / 2, _
EndX:=shpRect.Left, _
EndY:=shpRect.Top + ArrowIdx * ArrowOff) 'RectSide / 2 + VerticalOff)
shpLine.Line.EndArrowheadStyle = msoArrowheadTriangle
shpLine.Line.EndArrowheadLength = msoArrowheadLengthMedium
shpLine.Line.EndArrowheadWidth = msoArrowheadWidthMedium

Set shpLabel = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=shpRect.Left - RectLeft + RectSide + 1, _
Top:=shpRect.Top + ArrowIdx * ArrowOff - LabelHeight, _
Width:=RectLeft - RectSide - 1, _
Height:=LabelHeight)
shpLabel.TextFrame.Characters.Text = .Cells(i, "D").Value & " " & .Cells(i, "C").Value
shpLabel.TextFrame.HorizontalAlignment = xlCenter
shpLabel.Line.Visible = msoFalse
shpLabel.ZOrder msoSendToBack
Next i
End With
End Sub

[AleemAM123]

This works great, thanks XLD.

I need to extend the problem though. I failed to include another block popping up in column A that wasn't previously introduced in column B and so the diagram is getting stuck there.

[Bob Phillips]

You seem to have links in there that go in reverse, it was quite difficult to control the original, this would be degrees harder.

[AleemAM123]

Yes there are links that are listed later that may have to come in before e.g. L is in front of A but they don't necessarily have to be placed before A in the diagram. They can be placed below A or at the point where a new block would have been dropped. At any point in time there may be 3 to 5 blocks before A.

[Bob Phillips]

The difficulty as I see it is that A and L both are parents of B, but T111 is a parent of L, so which column does L go in, 1 or 2 (or some other)?

[AleemAM123]

ohhh... that's because it's not an ordinary flowchart. Don't think of any of them as parents. They can be interchanged, any one prefixed with a T can appear in any column. And the entire chart may look as if contain several unconnected charts. If it were possible (I dunno) maybe blocks that are connected to eachother can be drawn in a circular cluster and then the lines can be joined? But then can you find a block that has a particular name and draw a line from it to the other that it is connected to?

[Bob Phillips]

Show me an example of how you would see that link-forward link-back looking.

[AleemAM123]

I've put in a couple more blocks, the placement being random. I see clarity and ease of reading the diagram becoming an issue.