On Mar 16, 11:23*am, nofam wrote:
On Mar 15, 11:14*pm, joel wrote:



I added the feature for the BULK color to be yellow. *I don't know
where you are gettng the dates for the 1st row. *I looked at the
original code and thought you wanted the 1st row to be the minimum date
in column b and the max date in Column C. *the dates you are asking for
aren't in the data you provided so I don't know where to get these dates
from.

VBA Code:
--------------------

Enum DateState
* findmindate
* findmaxdate
* End Enum

* Sub Gantt_Chart()
* Application.ScreenUpdating = False
* Dim mindate As Date
* Dim maxdate As Date
* Dim columnoffset As Integer
* Dim task As Variant

* Dim colcount As Integer
* Dim daterange As Range
* Dim firstdate As Range
* Dim frequency As Integer
* Dim GanttStart As Range
* Dim HeaderDates As Range
* Dim lastcol As Integer
* Dim lastdate As Range
* Dim lastrow As Integer
* Dim startrow As Integer
* Dim startcolumn As Integer
* Dim startdate As Date
* Dim startdatestr As String
* Dim timeperiod As Integer

* startrow = 1 'Change this as necessary
* startcolumn = 1 'Where to start the gantt chart
* ganttcolumnoffset = 3
* startdatestr = "Jan-4-2010"
* startdate = DateValue(startdatestr)
* frequency = 7 'Could be 1 for weekly chart
* timeperiod = 52

* 'clear chart area
* Range(Cells(startrow, startcolumn + ganttcolumnoffset), _
* Cells(Rows.Count, Columns.Count)).Delete

* 'create date headings in row 1
* colcount = startcolumn + ganttcolumnoffset
* For timecount = 0 To (timeperiod - 1)
* Cells(startrow, colcount) = startdate + (frequency * timecount)
* colcount = colcount + 1
* Next timecount

* Set firstdate = Cells(startrow, startcolumn + ganttcolumnoffset)
* Set lastdate = firstdate.End(xlToRight)
* Set daterange = Range(firstdate, lastdate)

* daterange.EntireColumn.AutoFit
* daterange.NumberFormat = "mm/dd/yy"

* lastrow = Cells(startrow + 2, startcolumn).End(xlDown).Row
* Set mindaterange = _
* Range(Cells(startrow + 2, startcolumn + 1), _
* Cells(lastrow, startcolumn + 1))
* Set maxdaterange = _
* Range(Cells(startrow + 2, startcolumn + 2), _
* Cells(lastrow, startcolumn + 2))

* 'create main task chart
* mindate = WorksheetFunction.Min(mindaterange)
* maxdate = WorksheetFunction.Max(maxdaterange)

* minheaderdatecolumn = daterange.Column
* State = DateState.findmindate
* For Each cell In daterange
* Select Case State

* Case DateState.findmindate

* If cell.Offset(0, 1) <= mindate Then
* minheaderdatecolumn = minheaderdatecolumn + 1
* Else
* Datecount = mindate
* Cells(startrow + 1, minheaderdatecolumn) = Datecount
* maxheaderdatecolumn = minheaderdatecolumn
* State = DateState.findmaxdate
* End If
* Case DateState.findmaxdate
* If cell <= maxdate Then
* Datecount = Datecount + frequency
* maxheaderdatecolumn = maxheaderdatecolumn + 1
* Cells(startrow + 1, maxheaderdatecolumn) = Datecount

* Else
* Exit For
* End If
* End Select
* Next cell

* If InStr(UCase(Range("A" & (startrow + 2))), "BULK") 0 Then
* mycolor = 6
* Else
* mycolor = 3
* End If

* Call makechart(startrow + 1, minheaderdatecolumn, _
* maxheaderdatecolumn, mycolor)

* 'create chart for each row
* For RowCount = (startrow + 2) To lastrow

* mindate = Cells(RowCount, startcolumn + 1)
* maxdate = Cells(RowCount, startcolumn + 2)

* minheaderdatecolumn = daterange.Column

* State = DateState.findmindate
* For Each cell In daterange
* Select Case State

* Case DateState.findmindate

* If cell.Offset(0, 1) <= mindate Then
* minheaderdatecolumn = minheaderdatecolumn + 1
* Else
* Datecount = mindate
* Cells(RowCount, minheaderdatecolumn) = Datecount
* maxheaderdatecolumn = minheaderdatecolumn
* State = DateState.findmaxdate
* End If

* Case DateState.findmaxdate
* If cell <= maxdate Then
* Datecount = Datecount + frequency
* maxheaderdatecolumn = maxheaderdatecolumn + 1
* Cells(RowCount, maxheaderdatecolumn) = Datecount

* Else
* Exit For
* End If
* End Select
* Next cell

* If InStr(UCase(Range("A" & RowCount)), "BULK") 0 Then
* mycolor = 6
* Else
* mycolor = 3
* End If

* Call makechart(RowCount, minheaderdatecolumn, _
* maxheaderdatecolumn, mycolor)

* Next RowCount

* End Sub

* Sub makechart(ByVal myrow As Integer, _
* ByVal startcol As Integer, ByVal endcol As Integer, _
* ByVal mycolor As Integer)

* Set GanttRange = Range(Cells(myrow, startcol), _
* Cells(myrow, endcol))

* 'format dates
* With GanttRange

* .Interior.ColorIndex = mycolor
* .NumberFormat = "dd/mm"

* .HorizontalAlignment = xlGeneral
* .VerticalAlignment = xlBottom
* .WrapText = False
* .Orientation = -90
* .AddIndent = False
* .IndentLevel = 0
* .ShrinkToFit = False
* .ReadingOrder = xlContext
* .MergeCells = False
* End With

* With GanttRange.Font
* .Name = "Arial"
* .FontStyle = "Regular"
* .Size = 8
* .Strikethrough = False
* .Superscript = False
* .Subscript = False
* .OutlineFont = False
* .Shadow = False
* .Underline = xlUnderlineStyleNone
* .ColorIndex = xlAutomatic
* End With

* With GanttRange
* .Borders(xlDiagonalDown).LineStyle = xlNone
* .Borders(xlDiagonalUp).LineStyle = xlNone
* With .Borders(xlEdgeLeft)
* .LineStyle = xlContinuous
* .Weight = xlThin
* .ColorIndex = xlAutomatic
* End With

* With .Borders(xlEdgeTop)
* .LineStyle = xlContinuous
* .Weight = xlThin
* .ColorIndex = xlAutomatic
* End With

* With .Borders(xlEdgeBottom)
* .LineStyle = xlContinuous
* .Weight = xlThin
* .ColorIndex = xlAutomatic
* End With

* With .Borders(xlEdgeRight)
* .LineStyle = xlContinuous
* .Weight = xlThin
* .ColorIndex = xlAutomatic
* End With

* .Borders(xlInsideVertical).LineStyle = xlNone
* End With

* Application.ScreenUpdating = True
* End Sub

--------------------

--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:http://www.thecodecage.com/forumz/sh...d.php?t=186842

http://www.thecodecage.com/forumz/chat.php

Hi Joel,

Thanks for adding the additional color for BULK - looks great. *Sorry
if I didn't explain the date issue correctly:

In the below data (which is part of the actual data I'm using), the
column headings are in A1:C1. *The mindate/maxdate of the range as
below would be 01/02/2010 (in cell B2) and 30/09/2010 (in cell C9).
The date headings for the range starts in D1 and runs to wherever your
code specifies.

All of this is working as it should, but as per the examples below,
the yellow bar for the first event under the headings (in row 2)
FB1905 runs from 08/02/2010 to 30/09/2010, where as it should run from
01/02/2010 to 14/03/2010.

The next event however (FB1906) is showing correctly from 08/02/2010
to 21/03/2010 as are all the other subsequent ones?

Promo
start * * * * * finish
FB1905 - MEGA FB1905 BULK MERCH 1 *10 * * * * 1/02/2010 14/03/2010
FB1906 - MEGA FB1906 BULK MERCH 2 *10 * * * * 8/02/2010 21/03/2010
FB1907 - MEGA FB1907 BULK MERCH 3 *10 * * * *15/02/2010 28/03/2010
FB1170 - FB1170 HOUSEWASH BRUSH BUY OPP 22/02/2010 * * *31/03/2010
FEB500 - FEB500 HOUSEWASH BRUSH BUY OPP22/02/2010 * * * 31/03/2010
FB1908 - MEGA FB1908 BULK MERCH 4 *10 * * * *22/02/2010 4/04/2010
MAR298 - MAR298 TRADE MAILER *10 * * * * * * * * * * 1/03/2010 *31/03/2010
AU1173 - AU1173 MEGA ODOOR FURN IND 10 * * * *8/09/2010 30/09/2010

So essentially, the code is perfect other than for that first event
contained in Row 2.

Hope this makes sense!!

Also, just out of interest, what does the Enum/End Enum routine at the
start of the code do? *I've never come across this before?

Cheers
Chris

Hey,

I've uploaded a copy of the workbook if you want to see what I mean as
above:

http://www.sendspace.com/file/rux5nq

Cheers
Chris