VBA - Vertical organization display on set chart

[dfelz]

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!!

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)
    'Selection.ShapeRange.Shadow.Type = msoShadow5
    
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

BD List.jpgBD Chart.jpg

[Aussiebear]

Cross posted in another forum I noticed. Did you read the forum rules regarding cross posting or simply did not bother? Why don't you people realise that vba is such a small component of the internet that members here are also members of other forums, and as such all instances of cross posting are in fact 'NOTICED'. If you think that cross posting is absolutely necessary, then do us all the courtesy of mentioning that the issue is posted on another forum by indicating so.

[dfelz]

Yes Aussiebear, i apologize that i cross posted this topic, i was not aware of the rules and i will not make that mistake again.

This thread is cross-posted on two other forums, but for some reason when i try to put the urls below, the forun says post denied, limited by number of urls or forbidden words, but there are only two urls...?

[Aussiebear]

David, you need to up your post count before posting url's, however you can still assist by naming the forums.

[SamT]

Hello, David.

One issue I see is that you have a Variable called "NAME" "Name" is a reserved Keyword in Excel. It's use as a Variable is already causing problems, as you can see looking at the code; Every instance of "Name" is all Upper Case, even when it is not used as a variable.VBA is Confused.

Try renaming that variable to something that means something to programmers, Like "Project." As in "Project" is the Header for that Column.

Do the same with "PH." I suggest "Milestone" as "Milestone" is in the Header for that Column.
As a programmer I am Clueless what "LL" stands For. I always use "rw" as the standard Row index.

I am sure glad that you know which sheet and cell is Active at any given time. As a programmer I can't depend on the User always doing the Right Thing for my Code to work. Besides, the Selected Cell is not always the Active Cell. Usually, but then a grade 3 bolt is usually ok.

dictate the vertical organization dependent on the GM_(sic) column value. The range will be fixed, from -10% to +30%.

When I look at the "GN% This Month" Column, I see values as high as 66%. I am confused.

You can make your code more self commenting with Enumerated Constants

Enum ColumnNumbers
ProjectCol = 3
MileStoneCol = 4
PercentCompleteCol = 6
'Etc
End Enum

For rw = 8 to Cells(Rows.Count, ProjectCol).End(xlUp).Row

With Sheets("DB").Rows(rw)
ProjectName = .Cells(ProjectCol) 'Dot Cells means Cells belongs to the "With" Object.
'A Range's Cells are counted from Left to Right then Down. A single Row has no "Down."

Select Case .Cells(MilestoneCol).Value
Case "Contract Nego": PHASE = 1 
Case "Permitting": PHASE = 2 
Case "Design": PHASE = 3 
Case "Manufacturing": PHASE = 4 
Case "Installation": PHASE = 5 
Case "Commissioning": PHASE = 6 
Case "Liability": PHASE = 7 
End Select

PercentComplete = .Cells(PercentCompleteCol) 'Note that Value is the Default Property of a Range, I have been mixing it up for you.
Risk = .Cells(RiskCol)
Order_V = .Cells(Order_VCol)
'Etc
'etc.
End With 'this Row
Next rw ' Loop to the next Row.

Notice how the code is self explanatory, (Risk comes from the Risk Column) and self checking, (Risk = .Cells(PercentCompleteCol) is just wrong.

I hope this gives you some ideas to really improve your code..

[dfelz]

Sam T. Thank you very much for the improvement tips, i will go through them and play around with getting them all integrated.

Just to comment really quickly on the GM value range, the values in that column were just typed at random for testing. since then the table column has been put under a data validation criteria so that the input user can only enter values within my decided range.

I will post back once I get these changes implemented. i have also made some other additions that i am sure will be scrutinized by the manner that the code is laid out, but we will get to that later.

[dfelz]

Sam, getting a compile error that highlights "Enum ColumnNumbers" and says Invalid inside procedure

[SamT]

Yep, they sure are. Put your Enums after the Option Explicit and before any other Module Constants and Variables, which also come before any Subs or functions.

Example Layout of the code on a Code Page.

Option Explicit 'Highly recommended at the top of all Modules.

Enum SomeEnumeratedConstants
Constant1
Constant2
End Enum

Private Const mMyConstant As String = "This is a Module Level Constant" 'Note the "m" prefix, Normally not used, but is handy in Complex Code. 

Public MyVar a Long 'This variable is accessible to all Procedures in any Module

Dim MyNextVar As Variant 'This variable is accessible to all Procedures in this module only.

Sub Test1()
'The First Sub 
End Sub

In the VBA Menu >> Tools >> Options >> Editor Tab, if you check "Require Variable Declaration," the VBE will auto-insert "Option Explicit" into all new Code Pages. I check all the boxes in the "Code Settings" Frame.