I have created code that allows me to create a flowchart based on data
on a seperate sheet. When I run the macro, it automatically builds the
flowchart, but I also want it to be able to able to continue down a
decision block when the need arises.

For example,
I am pulling data from a sheet in my workbook labelled data for
flowchart. My macro creates a flowchart that has a, b, c, d, and then
decision block e on a different sheet in the workbook. I would like to
be able to put process f1 linear to e and then process f2 below the
decision block, with g2, h2, i2 all showing in line after f2. Then
process g1, h1, i1 all showing up in line after f1. If anyone can
think of a way to help me on this, I would appreciate it. If you need
more info, please let me know and I will post it.

Jay:

I did this a few years ago:

http://groups.google.com/group/micro...bca2f03682ce1c

For some reason, I think I later found an error in it, but I don't remember
what it is. It may give you a start though.

--
Dick Kusleika
MVP-Excel
www.dailydoseofexcel.com

Jay wrote:
I have created code that allows me to create a flowchart based on data
on a seperate sheet. When I run the macro, it automatically builds
the flowchart, but I also want it to be able to able to continue down
a decision block when the need arises.

For example,
I am pulling data from a sheet in my workbook labelled data for
flowchart. My macro creates a flowchart that has a, b, c, d, and then
decision block e on a different sheet in the workbook. I would like
to be able to put process f1 linear to e and then process f2 below the
decision block, with g2, h2, i2 all showing in line after f2. Then
process g1, h1, i1 all showing up in line after f1. If anyone can
think of a way to help me on this, I would appreciate it. If you need
more info, please let me know and I will post it.

Hey Dick,
I appreciate your help, but I think I may have communicated my need
wrong. I am not pulling my data from the flowchart, but charting from
the data. Here is the code that I am using. Feel free to test it out.
I need to branch down from decision shapes and then basically start a
new line for the flowchart.
Jay
Sub CreateRIEFlowChart()
Dim sMsg As String, sMySheet As String, sSourceSheet As String,
sDsc As String, sCtg As String
Dim bTE As Boolean, bPE As Boolean, bPX As Boolean, bTX As Boolean,
bSandE As Boolean, b1First As Boolean, bWrap As Boolean ' bSandE= start
& ending ovals
Dim w As Worksheet
Dim lZ As Long
Dim r1 As Range, r2 As Range
Dim iRow As Integer, iRsp As Integer, iL As Integer, iT As Integer
' iL=left distance iT=top
Dim s As Shapes
Dim sShp1 As Shape, sShp2 As Shape, c As Shape
Const iW = 76# ' Width
Const iH = 60# ' Height
Const iG = 25# ' Gap between boxes
Const iDesc = 2 ' column for description in the BfrTimObMstr or
Time Obsr
Const iCategory = 3 ' column for category in the BfrTimObMstr or
Time Obsr
Const i1stRow = 2 ' Incase ever add more top rows to BfrTimObMstr
or Time Obsr
Const iPageWidth = 500# ' Current version only pages down & not
across

On Error GoTo err_cmd
sMsg = "This feature builds a Before Flow Map based on data from a
TDVT sheet. Have you completed this? This feature does not allow
Edit-Undo. Have you saved your file?"
If MsgBox(sMsg, vbYesNo, "Auto Build Continue?") = vbNo Then
Exit Sub
End If

Application.ScreenUpdating = False
sMySheet = ActiveSheet.Name

bTE = False
bPE = False
Select Case sMySheet
Case "Before Flow Map"
For Each w In Worksheets
If w.Name = "BfrTimObMstr" Then
bPE = True
End If
If w.Name = "Time Obsr" Then
bTE = True
End If
Next w
If bPE = False Or bTE = False Then ' Will do case where
both True later
If bPE Then
sSourceSheet = "BfrTimObMstr"
Else
If bTE Then
sSourceSheet = "Time Obsr"
Else ' both non-existant
sSourceSheet = "None"
End If
End If
End If
Case "Before Flow Map 2"
For Each w In Worksheets
If w.Name = "BfrTimObMstr 2" Then
bPE = True
End If
If w.Name = "Time Obsr 2" Then
bTE = True
End If
Next w
If bPE = False Or bTE = False Then ' Will do case where
both True later
If bPE Then
sSourceSheet = "BfrTimObMstr 2"
Else
If bTE Then
sSourceSheet = "Time Obsr 2"
Else ' both non-existant
sSourceSheet = "None"
End If
End If
End If
Case Else
Beep
MsgBox "Must be on Before Flow Map (or Before Flow Map 2)
sheet for this macro to work."
Exit Sub
End Select
If sSourceSheet = "None" Then
Beep
If sMySheet = "Before Flow Map 2" Then
MsgBox "No After Process Observation sheet (BfrTimObMstr 2)
or Time Observation sheet (Time Obsr 2) exists!"
Else
MsgBox "No Process Observation sheet (BfrTimObMstr) or Time
Observation sheet (Time Obsr) exists!"
End If
Exit Sub
End If
If bPE And bTE Then ' Both exists so check Content sheet to see
which one X'd
Sheets("Content").Select
Range("C2").Select
lZ = Cells(65535, 3).End(xlUp).Row
Set r1 = Range(Cells(2, 3), Cells(lZ, 4))
r1.Select
If sMySheet = "Before Flow Map" Then ' not an After
sheet
Set r2 = r1.Find(What:="BfrTimObMstr", LookIn:=xlValues,
LookAt:= _
xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=True)
If Not r2 Is Nothing Then ' found it
r2.Select
iRow = ActiveCell.Row
If UCase(Worksheets("Content").Cells(iRow, 5).Value) =
"X" Then
bPX = True
Else
bPX = False
End If
Else ' did not find it so treat it like not X'd (user may
have zapped row if not used)
bPX = False
End If
r1.Select
Set r2 = r1.Find(What:="Time Obsr", LookIn:=xlValues,
LookAt:= _
xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=True)
If Not r2 Is Nothing Then ' found it
r2.Select
iRow = ActiveCell.Row
If UCase(Worksheets("Content").Cells(iRow, 5).Value) =
"X" Then
bTX = True
Else
bTX = False
End If
Else ' did not find it so treat it like not X'd (user may
have zapped row if not used)
bTX = False
End If
If bPX Then
If bTX Then
' can't be both but it is!
sSourceSheet = "Both"
Else
sSourceSheet = "BfrTimObMstr"
End If
Else ' not bPX
If bTX Then
sSourceSheet = "Time Obsr"
Else
' can't be neither but it is!
sSourceSheet = "None"
End If
End If
Else ' working with After which gets real messy cause
don't know if side-by-side or seperate row
Set r2 = r1.Find(What:="BfrTimObMstr 2", LookIn:=xlValues,
LookAt:= _
xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=True)
If Not r2 Is Nothing Then ' found it
r2.Select
iRow = ActiveCell.Row
If UCase(Worksheets("Content").Cells(iRow, 5).Value) =
"X" Then
bPX = True
Else
bPX = False
End If
Else ' did not find it so treat it like not X'd (user may
have zapped row if not used)
bPX = False
End If
r1.Select
Set r2 = r1.Find(What:="Time Obsr 2", LookIn:=xlValues,
LookAt:= _
xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=True)
If Not r2 Is Nothing Then ' found it
r2.Select
iRow = ActiveCell.Row
If UCase(Worksheets("Content").Cells(iRow, 5).Value) =
"X" Then
bTX = True
Else
bTX = False
End If
Else ' did not find it so treat it like not X'd (user may
have zapped row if not used)
bTX = False
End If
If bPX Then
If bTX Then
' can't be both but it is!
sSourceSheet = "Both"
Else
sSourceSheet = "BfrTimObMstr 2"
End If
Else ' not bPX
If bTX Then
sSourceSheet = "Time Obsr 2"
Else
' can't be neither but it is!
sSourceSheet = "None"
End If
End If
End If
Range("A1").Select ' house cleaning!
If sSourceSheet = "None" Then
sMsg = "Which is your data source? The Process Obersvation
sheet (select Yes) or the Time Observation sheet (select No)? Note
selection on Content sheet to avoid this message in the future."
iRsp = MsgBox(sMsg, vbYesNoCancel)
Select Case iRsp
Case vbYes
If sMySheet = "Before Flow Map" Then ' not
an After sheet
sSourceSheet = "BfrTimObMstr"
Else
sSourceSheet = "BfrTimObMstr 2"
End If
Case vbNo
If sMySheet = "Before Flow Map" Then ' not
an After sheet
sSourceSheet = "Time Obsr"
Else
sSourceSheet = "Time Obsr 2"
End If
Case Else ' vbCancel
Exit Sub
End Select
End If
If sSourceSheet = "Both" Then
sMsg = "Which is your data source? The Process Obersvation
sheet (select Yes) or the Time Observation sheet (select No)? Both are
checked on Content sheet!"
iRsp = MsgBox(sMsg, vbYesNoCancel)
Select Case iRsp
Case vbYes
If sMySheet = "Before Flow Map" Then ' not
an After sheet
sSourceSheet = "BfrTimObMstr"
Else
sSourceSheet = "BfrTimObMstr 2"
End If
Case vbNo
If sMySheet = "Before Flow Map" Then ' not
an After sheet
sSourceSheet = "Time Obsr"
Else
sSourceSheet = "Time Obsr 2"
End If
Case Else ' vbCancel
Exit Sub
End Select
End If
End If
Sheets(sSourceSheet).Select
ActiveSheet.Cells(i1stRow, iCategory).Select ' Categorization
Code column
lZ = Cells(65535, iCategory).End(xlUp).Row
Range("A2").Select
If lZ < i1stRow Then ' no data!
Beep
MsgBox "I need some data before I can build a Before Flow Map!
At a minimum, select Categorization Code and enter a Description for
each step of the process."
Exit Sub
End If

Sheets(sMySheet).Select
' Prompt the user if want starting and ending ovals
sMsg = "Do you want a STARTING and ENDING ovals?"
iRsp = MsgBox(sMsg, vbYesNoCancel)
Select Case iRsp
Case vbYes
' Add Starting and Ending ovals
bSandE = True
Case vbNo
' Do NOT add Starting and Ending ovals
bSandE = False
Case Else ' vbCancel
Exit Sub
End Select

' Now for the real work
iT = 40# ' Top
b1First = True
bWrap = False
iL = iG
Set s = ActiveSheet.Shapes
If s.Count 0 Then
sMsg = "This sheet already has " & s.Count & " drawing shapes.
Continue?"
If MsgBox(sMsg, vbYesNo, "Auto Build Continue?") = vbNo Then
Exit Sub
End If
End If
If bSandE Then
Set sShp1 = s.AddShape(msoShapeFlowchartTerminator, iL, iT +
19, iW, iH - 39)
sShp1.TextFrame.Characters.Text = "Start"
sShp1.Fill.ForeColor.SchemeColor = 1
iL = iL + iG + iW
Else
b1First = False
End If
iRow = i1stRow
sCtg = UCase(Trim(Worksheets(sSourceSheet).Cells(iRow,
iCategory).Value))
Do
If b1First Then
If sCtg = "VA" Then
Set sShp2 = s.AddShape(msoShapeFlowchartProcess, iL,
iT, iW, iH)
sShp2.Fill.ForeColor.SchemeColor = 3
Else
If sCtg = "PW" Then
Set sShp2 = s.AddShape(msoShapeFlowchartDelay, iL,
iT, iW, iH)
sShp2.Fill.ForeColor.SchemeColor = 2
Else
If sCtg = "I" Then
Set sShp2 =
s.AddShape(msoShapeFlowchartDecision, iL, iT, iW, iH)
sShp2.Fill.ForeColor.SchemeColor = 51
Else
Set sShp2 =
s.AddShape(msoShapeFlowchartOffpageConnector, iL, iT, iW, iH)
sShp2.Fill.ForeColor.SchemeColor = 51
End If
End If
End If
sShp2.TextFrame.Characters.Text =
Worksheets(sSourceSheet).Cells(iRow, iDesc).Value

Else
If sCtg = "VA" Then
Set sShp1 = s.AddShape(msoShapeFlowchartProcess, iL,
iT, iW, iH)
sShp1.Fill.ForeColor.SchemeColor = 3
Else
If sCtg = "PW" Then
Set sShp1 = s.AddShape(msoShapeFlowchartDelay, iL,
iT, iW, iH)
sShp1.Fill.ForeColor.SchemeColor = 2
Else
If sCtg = "I" Then
Set sShp1 =
s.AddShape(msoShapeFlowchartDecision, iL, iT, iW, iH)
sShp1.Fill.ForeColor.SchemeColor = 51
Else
Set sShp1 =
s.AddShape(msoShapeFlowchartOffpageConnector, iL, iT, iW, iH)
sShp1.Fill.ForeColor.SchemeColor = 51
End If
End If
End If
sShp1.TextFrame.Characters.Text =
Worksheets(sSourceSheet).Cells(iRow, iDesc).Value

End If
If iRow i1stRow Or bSandE Then
If bWrap Then
Set c = s.AddConnector(msoConnectorElbow, 0, 0, 100,
100)
bWrap = False
Else
Set c = s.AddConnector(msoConnectorStraight, 0, 0, 100,
100)
End If
If b1First Then
If sShp1.ConnectionSiteCount = 4 Then
c.ConnectorFormat.BeginConnect
ConnectedShape:=sShp1, ConnectionSite:=4
Else ' must be 8 which is what the oval is
c.ConnectorFormat.BeginConnect
ConnectedShape:=sShp1, ConnectionSite:=7
End If
If sShp2.ConnectionSiteCount = 4 Then
c.ConnectorFormat.EndConnect ConnectedShape:=sShp2,
ConnectionSite:=2
Else
c.ConnectorFormat.EndConnect ConnectedShape:=sShp2,
ConnectionSite:=3
End If
c.Line.EndArrowheadStyle = msoArrowheadTriangle
b1First = False
Else
If sShp2.ConnectionSiteCount = 4 Then
c.ConnectorFormat.BeginConnect
ConnectedShape:=sShp2, ConnectionSite:=4
Else ' must be 8 which is what the oval is
c.ConnectorFormat.BeginConnect
ConnectedShape:=sShp2, ConnectionSite:=7
End If
If sShp1.ConnectionSiteCount = 4 Then
c.ConnectorFormat.EndConnect ConnectedShape:=sShp1,
ConnectionSite:=2
Else
c.ConnectorFormat.EndConnect ConnectedShape:=sShp1,
ConnectionSite:=3
End If
c.Line.EndArrowheadStyle = msoArrowheadTriangle
b1First = True
End If
Else ' first time through loop and no bSandE
b1First = True
End If
iRow = iRow + 1
If iL iPageWidth Then
iL = iG
iT = iT + iH + iG
bWrap = True
Else
iL = iL + iG + iW
End If
sCtg = UCase(Trim(Worksheets(sSourceSheet).Cells(iRow,
iCategory).Value))
Loop While Len(sCtg) 0 And iRow < lZ + 1
If bSandE Then
If bWrap Then
Set c = s.AddConnector(msoConnectorElbow, 0, 0, 100, 100)
bWrap = False
Else
Set c = s.AddConnector(msoConnectorStraight, 0, 0, 100,
100)
End If
If b1First Then
Set sShp2 = s.AddShape(msoShapeFlowchartTerminator, iL, iT
+ 19, iW, iH - 39)
sShp2.TextFrame.Characters.Text = "End"

If sShp1.ConnectionSiteCount = 4 Then
c.ConnectorFormat.BeginConnect ConnectedShape:=sShp1,
ConnectionSite:=4
Else ' must be 8 which is what the oval is
c.ConnectorFormat.BeginConnect ConnectedShape:=sShp1,
ConnectionSite:=7
End If
If sShp2.ConnectionSiteCount = 4 Then
c.ConnectorFormat.EndConnect ConnectedShape:=sShp2,
ConnectionSite:=2
Else
c.ConnectorFormat.EndConnect ConnectedShape:=sShp2,
ConnectionSite:=3
End If
c.Line.EndArrowheadStyle = msoArrowheadTriangle
b1First = False
Else
Set sShp1 = s.AddShape(msoShapeFlowchartTerminator, iL, iT
+ 19, iW, iH - 39)
sShp1.TextFrame.Characters.Text = "End"
sShp1.Fill.ForeColor.SchemeColor = 1
If sShp2.ConnectionSiteCount = 4 Then
c.ConnectorFormat.BeginConnect ConnectedShape:=sShp2,
ConnectionSite:=4
Else ' must be 8 which is what the oval is
c.ConnectorFormat.BeginConnect ConnectedShape:=sShp2,
ConnectionSite:=7
End If
If sShp1.ConnectionSiteCount = 4 Then
c.ConnectorFormat.EndConnect ConnectedShape:=sShp1,
ConnectionSite:=2
Else
c.ConnectorFormat.EndConnect ConnectedShape:=sShp1,
ConnectionSite:=3
End If
c.Line.EndArrowheadStyle = msoArrowheadTriangle
b1First = True
End If
End If

Beep
Application.ScreenUpdating = True
MsgBox "Completed! Now add your decision points, branch points,
feedback loops and additional data relative to the Logical flow."
Exit Sub

err_cmd:
Beep
Application.ScreenUpdating = True
MsgBox Err.Number & " " & Err.Description
Exit Sub

End Sub