Hello VBA Express team, I am new to this forum, and am looking for some help on a coding dilemma. First some background on the program, i did not write this entire program, it was given to me from a coworker who wanted it modified more to his needs and he knew i have some VBA experience (I am a mechanical engineer, not computer, so codding is not my specialty). I made a majority of the modifications that he wanted but am stuck on this one, that's where you guys and gals come in.
The program takes a list of projects and sorts them by the phase they are in (there are 7 available phases) then locates them horizontally within that phase section on the graph, and depending on the percent complete column, it locates them more precisely horizontally within that section. It takes the total project value and draws a bubble for its marker, and the bubble size is dependent on how big the project value is, then fills in the color for either low, med, or high risk.
What i would like to do is have the program display the projects in the same way they are currently, but dictate the vertical organization dependent on the GM column value. The range will be fixed, from -10% to +30%.
I have attached screen shots of the list where the information is derived and the chart where the program displays the information, as well as the code.
Thank you very much in advance for your help!!
-David F
The program takes a list of projects and sorts them by the phase they are in (there are 7 available phases) then locates them horizontally within that phase section on the graph, and depending on the percent complete column, it locates them more precisely horizontally within that section. It takes the total project value and draws a bubble for its marker, and the bubble size is dependent on how big the project value is, then fills in the color for either low, med, or high risk.
What i would like to do is have the program display the projects in the same way they are currently, but dictate the vertical organization dependent on the GM column value. The range will be fixed, from -10% to +30%.
I have attached screen shots of the list where the information is derived and the chart where the program displays the information, as well as the code.
Thank you very much in advance for your help!!
Code:
Sub TEST()
Dim ORDER_V, PHASE, LL, PERCENT, X, Y As Double
Dim NAME, PH, RISK As String
Application.ScreenUpdating = False
Sheets("Chart").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Chart_Form").Visible = True
Sheets("Chart_Form").Copy Before:=Sheets(2)
Sheets("Chart_Form (2)").NAME = "Chart"
Sheets("Chart_Form").Select
ActiveWindow.SelectedSheets.Visible = False
AC_ = ActiveCell.Address
Range(Range("A1"), Range("A1").End(xlToRight)).Select
ActiveWindow.Zoom = 100
Range("A7").Select
Y = 1
LL = 8
Sheets("DB").Select
Cells(LL, 3).Select
While ActiveCell.Value <> ""
NAME = Cells(LL, 3).Value
PH = Cells(LL, 4).Value
If PH = "Contract Nego" Then PHASE = 1
If PH = "Permitting" Then PHASE = 2
If PH = "Design" Then PHASE = 3
If PH = "Manufacturing" Then PHASE = 4
If PH = "Installation" Then PHASE = 5
If PH = "Commissioning" Then PHASE = 6
If PH = "Liability" Then PHASE = 7
PERCENT = Cells(LL, 5).Value
RISK = Cells(LL, 12).Value
ORDER_V = Round(Cells(LL, 18).Value) * 1.5
If ORDER_V > 0 Then
If ORDER_V < 7.5 Then ORDER_V = 7.5
Run Draw_Project(ORDER_V ^ 0.9, PHASE, PERCENT / 100, 1, Y, "" & NAME, RISK)
Y = Y + 1
If Y > 10 Then
Y = 1
End If
End If
Cells(LL, 3).Select
LL = LL + 1
Wend
Cells(8, 1).Select
Sheets("Currency Lookup").Visible = True
ActiveWindow.Zoom = 100
Sheets("Chart").Select
Application.ScreenUpdating = True
End Sub
Function Draw_Project(R, PHASE, PERC, HScale, Y As Double, NAME, RISK As String)
Dim X As Double
If PHASE = 1 Then X = 0 + 138 * PERC
If PHASE = 2 Then X = 138 + 140 * PERC
If PHASE = 3 Then X = 278 + 140 * PERC
If PHASE = 4 Then X = 418 + 140 * PERC
If PHASE = 5 Then X = 558 + 140 * PERC
If PHASE = 6 Then X = 698 + 139 * PERC
If PHASE = 7 Then X = 838 + 125 * PERC
Sheets("Chart").Select
ActiveSheet.Shapes.AddShape(msoShapeOval, 31 - R / 2 + X, 156 + (Y - 1) * 54 + 54 / 2 - R / 2, R * HScale, R).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
If RISK = "Low" Then
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
.Solid
End With
End If
If RISK = "Med" Then
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 153)
.Transparency = 0
.Solid
End With
End If
If RISK = "High" Then
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
End If
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
[COLOR=darkgreen]'Selection.ShapeRange.Shadow.Type = msoShadow5[/COLOR]
If PHASE = 7 Then
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 35 - R / 2 + X - Len(NAME) * 9, 156 + (Y - 1) * 54 + 54 / 2, 0#, 0#).Select
Else
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 15 + 9 + R / 2 + X, 156 + (Y - 1) * 54 + 54 / 2, 0#, 0#).Select
End If
Selection.ShapeRange(1).TextFrame.AutoSize = msoTrue
Selection.Characters.Text = NAME
With Selection.Font
.NAME = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Cells(1, 1).Select
Sheets("DB").Select
End Function-David F
