Thread: Macro
View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Rick Rothstein \(MVP - VB\)[_1434_] Rick Rothstein \(MVP - VB\)[_1434_] is offline
external usenet poster
 
Posts: 1
Default Macro

Give the code below a try. It assumes the estimated costs are in Column C,
the start date in Column D, the finish date in Column E. Also, starting in
Column F, Row 1 are the date headers which must be real Excel dates (you can
use an entry like Feb-2008, which will default to the first of the month, or
enter a full date, and then format them all to your desired MMM-YY format).
Also, the start and finish dates need to be real dates also, but the can be
any day of the month (in case you want to be able to see exactly which dates
are the estimated start and finish dates within your chart). The estimated
costs, will be distributed throughout the months, but without regard to the
actual day within the month the activity starts or ends. So, if the
estimated cost is $3000 and the date span is from January 31, 2008 to March
1, 2008, that will be regarded as 3 month (which is the number of months
that will be shaded) and each of those months will have one-third of the
estimated cost ($1000 each) shown in them. Hopefully, this all meets with
your approval.

Sub GanttChart()
Dim X As Long
Dim Z As Long
Dim LastRow As Long
Dim LastCol As Long
Dim StartFinishDateCount As Long
Dim Start As Range
Dim Finish As Range
Dim DateSpan() As String
Const DateHeadersRow As Long = 1
Const DataStartRow As Long = 2
Const DataStartCol As Long = 6
Const EstimatedCostCol As String = "C"
Const StartDateCol As String = "D"
Const FinishDateCol As String = "E"
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, StartDateCol).End(xlUp).Row
LastCol = .Cells(DateHeadersRow, Columns.Count).End(xlToLeft).Column
ReDim DateSpan(DataStartCol To LastCol)
For X = DataStartCol To LastCol
DateSpan(X) = Format(Cells(1, X).Value, "mmm-yyyy")
Next
Range(Cells(DataStartRow, DataStartCol), Cells(LastRow, LastCol)).Clear
For X = DataStartRow To LastRow
StartFinishDateCount = 0
For Z = DataStartCol To LastCol
If DateSpan(Z) = Format$(.Cells(X, StartDateCol).Value, "mmm-yyyy")
Then
Set Start = Cells(X, Z)
StartFinishDateCount = StartFinishDateCount + 1
End If
If DateSpan(Z) = Format$(.Cells(X, FinishDateCol).Value, "mmm-yyyy")
Then
Set Finish = Cells(X, Z)
StartFinishDateCount = StartFinishDateCount + 1
End If
If StartFinishDateCount = 2 Then Exit For
Next
For Z = Start.Column To Finish.Column
Cells(X, Z).Value = Cells(X, EstimatedCostCol).Value /
(Finish.Column - Start.Column + 1)
Next
Range(Start, Finish).Cells.Interior.Color = RGB(172, 172, 172)
Next
End With
End Sub

Rick


"CMD" wrote in message
...
Hi Rick-
Thanks again for your help....and patience. Yes, I did simplify the
example
in my original post. I would like to use this to span multiple years.
Also,
for #2, I would like to divide the dollar amount up between the months.
So,
if I have $20K for an activity that spans Jan-Apr, I want to have $5K each
in
the shaded cells of Jan, Feb, Mar, Apr.

Chris

"Rick Rothstein (MVP - VB)" wrote:

See my other response to your other message for the answer to #1. I'm not
sure I understand what you want for #2. Are you asking to fill in numbers
into each cell that is shaded? If so, are you asking to have the dollar
value divided by the number of months, this being the same value, placed
in
each cell? Or did you want a cumulative dollar amount entered into each
cell?

Rick


"CMD" wrote in message
...
Hi Rick-
I think I figured it out and now have it working. I really appreciate
you
taking the time. Can I add a layer of complexity? (1) If its possible
to
change the date format to MMM-YY that would be great. (2) Is it
possible
for
me to add a 4th column up front and include a dollar amount and if a
dollar
amount exists, have it equally distributed over the shaded cells.
Thanks
again so much for your help.
Chris

"Rick Rothstein (MVP - VB)" wrote:

Here is some code to do that...

Sub GanttChart()
Dim X As Long
Dim LastRow As Long
Dim Start As Range
Dim Finish As Range
With Worksheets("Sheet3")
Range("D2:O999").ClearFormats
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
For X = 2 To LastRow
Set Start = Cells(X, 3 + Month(.Range("B" & X).Value & " 1,
2000"))
Set Finish = Cells(X, 3 + Month(.Range("C" & X).Value & " 1,
2000"))
Range(Start, Finish).Cells.Interior.Color = RGB(172, 172, 172)
Next
End With
End Sub

I used a gray color instead of black, but you can change the color on
a
per
row basis via the RGB function call if you want. Also, the code works
based
on 3-letter month abbreviations in Columns B and C as well as in your
headers; if you want something different, let me know and I'll modify
the
code to account for it.

Rick


"CMD" wrote in message
...
Hi. I am trying to mimic some MS Project functionality in Excel. I
want
to
try and automate the creation of a basic gantt chart. Is there a
way I
can
do the following:

Columns D - O are labeled months of the year. Column A is a task,
column
B
is a start month and column C is a stop month. I would like to set
it
up
such that once the user puts in a start/stop month, that the
respective
cells
(and everything in between) gets shaded a certain color.

So for example if I have a task of develop software in row 2 and the
start
stop is Feb/Apr, I would like cells E2, F2 and G2 to be shaded
black.

Thanks in advance.

Chris