HelpMeWithExcelPlease
New Member
- Joined
- Jul 27, 2017
- Messages
- 24
Hi all,
I have created a large Gantt chart in excel (through formulas, not as a chart). I have 2 additions I am trying to make to my sheet in order for it to be functional:
I have yet to figure out how to add the line for the current date, but I was hoping someone could help me with adding in the 5-point stars to the cells that are identified as milestone dates.
This link shows what my document currently looks like: link
Ideally, I'd like to assign a macro to the "Add Milestones" shape and have it create 5-point stars on the corresponding End Date for any row where column C is populated with a "Yes".
Currently, I have the following code written in to attempt to add these shapes, but somewhere in my code is an issue that is causing it to not function at all. My exposure to writing/editing this code is severely limited, so I was hoping someone here could provide some assistance or point me in the right direction.
Thank you in advance!!
I have created a large Gantt chart in excel (through formulas, not as a chart). I have 2 additions I am trying to make to my sheet in order for it to be functional:
- Adding in a date line for today - a red, bold border line that lines up with today's date
- Adding in a shape (5-point star) on the dates that are called out as being a milestone date
I have yet to figure out how to add the line for the current date, but I was hoping someone could help me with adding in the 5-point stars to the cells that are identified as milestone dates.
This link shows what my document currently looks like: link
Ideally, I'd like to assign a macro to the "Add Milestones" shape and have it create 5-point stars on the corresponding End Date for any row where column C is populated with a "Yes".
Currently, I have the following code written in to attempt to add these shapes, but somewhere in my code is an issue that is causing it to not function at all. My exposure to writing/editing this code is severely limited, so I was hoping someone here could provide some assistance or point me in the right direction.
Code:
Sub DoIt()
Dim rngStart As Range
Dim r As Long
Dim dte1 As Date
Dim rngToFind As Range
Dim sh As Shape
Dim sngLeft As Single
Dim sngTop As Single
Dim sngHeight As Single
Dim sngWidth As Single
'remove all shapes
For Each sh In ActiveSheet.Shapes
If Left(sh.Name, 7) = "5-Point" Then
sh.Delete
End If
Next
Set rngStart = ActiveSheet.Range("A7")
r = 1
Do While rngStart.Offset(r, 0) <> ""
If rngStart.Offset(r, 2) = "Yes" Then
dte1 = rngStart.Offset(r, 4)
Set rngToFind = ActiveSheet.Rows("5:5").Find(what:=dte1)
If Not rngToFind Is Nothing Then
sngWidth = 15
sngHeight = 15
sngLeft = rngToFind.Left + rngToFind.Width / 2 - sngWidth / 2
sngTop = rngStart.Offset(r, 0).Top + rngStart.Offset(r, 2).Height / 2 - sngHeight / 2
ActiveSheet.Shapes.AddShape(msoShape5pointStar, sngLeft, sngTop, sngWidth, sngHeight).Select
Else
MsgBox "End Date not found in top row"
End If
End If
r = r + 1
Loop
Range("A7").Select
End SubThank you in advance!!
