Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders

[nofam]

I've got some code that loops through a list of start/end dates and
fills in cells in each row based on the number of days between those
dates (kind of like a Gantt chart)

This works fine, but I'd like a way to add borders to the cell range
so they stand out a bit better. The difficulty I have is that the
borders are currently being added to each individual cell, rather than
one border for the whole selection:

Each set of selections must stay within the specific row, so I can't
have borders applied across multiple rows (hope that makes sense!)

Here is the code:Sub Gantt_Chart()
Application.ScreenUpdating = False
Dim mindate As Date
Dim maxdate As Date
Dim startcell As String
Dim columnoffset As Integer
Dim frequency As Integer
Dim task As Variant

Columns("E:E").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft

startcell = "B2" 'Change this as necessary
columnoffset = 3 'Where to start the gantt chart
frequency = 1 'Could be 7 for weekly chart
'Get minimum and maximum dates
Range(startcell).Select
Range(Selection.End(xlToRight), Selection.End(xlDown)).Select
mindate = Application.WorksheetFunction.Min(Selection)
maxdate = Application.WorksheetFunction.Max(Selection)
'Create date headings
Range(startcell).Offset(-1, columnoffset).Select
ActiveCell.Formula = mindate
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Offset(0, -1).Value >= maxdate
ActiveCell.Formula = ActiveCell.Offset(0, -1).Value + frequency
ActiveCell.Offset(0, 1).Select
Loop
'Create gantt chart
Range(startcell, Range(startcell).End(xlDown)).Select
For Each task In Selection
mindate = task.Value
maxdate = task.Offset(0, 1).Value
task.Offset(0, columnoffset).Select
'Get starting cell
Do Until Cells(Range(startcell).Row - 1, ActiveCell.Column).Value

= mindate

ActiveCell.Offset(0, 1).Select
Loop
'Color cell until end date
Do Until Cells(Range(startcell).Row - 1, ActiveCell.Column).Value

maxdate Or Cells(Range(startcell).Row - 1, ActiveCell.Column).Text =

""
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(0, 1).Select

Loop
Next
Range(startcell).Select
Columns("B").Select
Range("D1").Activate
Selection.EntireColumn.Hidden = True
Range("E1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.NumberFormat = "dd/mm"
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = -90
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

Columns("E:E").Select
Range(Selection, Selection.End(xlToRight)).Select
Columns("E:IL").EntireColumn.AutoFit


Application.ScreenUpdating = True
End Sub

The other thought I had was merging the colored cells so selecting
them 'as one' would be easier, but in my experience, merging creates
as many problems down the line as it solves!!

Can you help me with the code so it selects all the cells in a row
that it colors, and add one border to that range?

 

[nofam]

Hi Joel,

Thanks for the reply - when I paste your code, the following 3 rows
are highlighted red as syntax errors:

Set LastColCell = Range(startcell).Range(Selection.End(xlToRight)
Set LastCell = LastColCell.End(xlDown))

Set DateRange(StartDate,EndDate)

I think the first is missing a closing parenthesis, and the second has
an extra one?

But I'm not sure about the third?

Thanks again for your help!

Chris

 

[nofam]

I didn't test the code but was trying to give you other methods for
writing code that where you would be able to get an outline of the Gantt
Chart rather than turning on the inside borders

This line I didn't remove the "SELECTION" property
from
Set LastColCell = Range(startcell).Range(Selection.End(xlToRight)
to
Set LastColCell = Range(startcell).End(xlToRight)

This line I didn't remove the parenthesis
from
Set LastCell = LastColCell.End(xlDown))
to
Set LastCell = LastColCell.End(xlDown)

This line I left the equal sign out
from
Set DateRange(StartDate,EndDate)
to
Set DateRange = Range(StartDate,EndDate)

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

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

Hi Joel,

I'm very appreciative of your help on this - I realized you probably
didn't test the code, but to be honest I'm quite out of my depth with
what you've given me so if you don't mind helping me just a little
more that would be fantastic!

I made the changes you suggested, but the code is now breaking at the
startcell in the first line below with a 'Compile error - invalid
qualifier' -

'Create gantt chart
Set LastGanttCell = startcell.End(xlDown)
Set TaskRange = Range(startcell, LastGanttCell)



I took an educated guess at fixing it by changing:

Set LastGanttCell = startcell.End(xlDown)

to

Set LastGanttCell = Range(startcell).End(xlDown)


which Excel accepts, but now the code breaks at the Loop with a
'Compile error - Loop without do'?


Sorry to as for your help again Joel, but I feel we're very close to
making this work. If you need an example what I want to use this in,
please let me know!

Thanks again
Chris

 

[nofam]

I got rid of all the compiler errors.  I'm having a lot of problems
understanding your code because your original code is jumping around the
worksheet and suspect there are much better ways of achieving what yo
are trying to do.  I'm not sure how you columns are laid out.    I'vbe
worked a lot over the years with microsoft project so I understand Gantt
charts.  I'm not sure if the dates are sequential going down the rows or
are random like most projects.

I would orgainze code my code by simply moving down the worksheet like
this
'this isn't code but a description of How I would do it
For RowCount = 1 to LastRow
''check if new task
if New Task set Start Date to Task Date and Set End Date to Task
Date
if Last Row of task Create bar for Task
if Task Date > EndDate then set EndDate to Task Date
if  Task Date < StartDate then set Start Date to Task Date
next rowCount

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

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

  Range(Columns("E:E"), Columns("E:E").End(xlToRight)).Delete

  startcell = "B2" 'Change this as necessary
  columnoffset = 3 'Where to start the gantt chart
  frequency = 1 'Could be 7 for weekly chart
  'Get minimum and maximum dates
  Set LastColCell = Range(startcell).End(xlToRight)
  Set LastCell = LastColCell.End(xlDown)
  Set DataRange = Range(startcell, LastCell)

  mindate = Application.WorksheetFunction.Min(DataRange)
  maxdate = Application.WorksheetFunction.Max(DataRange)

  'Create date headings
  Set DateHeading = Range(startcell).Offset(-1, columnoffset)

  DateHeading.Formula = mindate
  Set StartDate = DateHeading.Offset(1, 0)
  Set LastDate = StartDate.End(xlDown)
  Set DateRange = Range(StartDate, EndDate)

  For Each cell In DateRange
  cell.Formula = cell.Offset(0, -1).Value + frequency
  If cell >= maxdate Then
  Set firstDate = cell
  Exit For
  End If

  Next cell

  'Create gantt chart
  Set LastGanttCell = Range(startcell).End(xlDown)
  Set TaskRange = Range(startcell, LastGanttCell)

  For Each task In TaskRange
  mindate = task.Value
  maxdate = task.Offset(0, 1).Value
  Set EndTask = task.Offset(0, columnoffset)

  Set Taskrow = Range(task, EndTask)

  For Each cell In Taskrow

  If cell >= mindate Then
  Set LastDate = cell
  Exit For
  End If
  Next cell
  Next task
  'Color cell until end date

  Set GanttRange = Range(firstDate, LastDate)

  GanttRange.Interior.ColorIndex = 3
  Range("D1").EntireColumn.Hidden = True

  Range("E1").Select
  Set LastCell = Range("E1").End(xlToRight)

  Set HeaderRange = Range("E1", LastCell)

  With HeaderRange
  .NumberFormat = "dd/mm"

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

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

  HeaderRange.EntireColumn.AutoFit

  Application.ScreenUpdating = True
  End Sub
--------------------

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

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

Hi Joel,

Sorry, I should've clarified this a bit better to start with.

I have a list of 3 columns (A, B, C):


Event Start Date Finish Date

Mar22 01/03/2010 09/03/2010
Mar11 05/03/2010 11/03/2010
Mar13 29/03/2010 16/04/2010
Apr09 01/04/2010 13/04/2010

What I'd like is a routine that firstly looks at the range B:C and
finds the earliest date in B:B, and the latest date in C:C (in the
above case it would be 01/03/2010 to 16/04/2010), and then populates
row 1 on that sheet with each date in the range in consecutive cells
(D1:AW1 in this case).

Then I'd like the code to loop through each row (one event per row)
and colour the cells for each event date range red with one solid
border for the whole range - with the above examples, the code would
colour cells D2:L2 and add one border for that whole range.

So effectively what you end up with is a list of events running down
Column A, a date range running across row 1, and a whole lot of
individually colored and bordered bars for each event in the row.
It's not really a Gantt chart in the true sense, as I'm not really
interested in dependencies etc. I simply called it that because it
kind of looks like one.

Hope that makes sense Joel - please let me know if there's anything
else you need.

Cheers
Chris

 

[nofam]

this is how I would write the code.  I think it is better to reference
the top left corner of the data and label this point as start row and
startcolumn.  It gets confusing to move backwards to get a column.

I had some problems due to the differences in US dates and English
Dates (mm/dd/yy verses dd/mm/yy).  I tried to make the code generic to
work either location.

The code now automatically puts the dates in the first row which your
posted code didn't.  I also like using good programming proactices.  the
code is more complicated but it prevents infinite loops from occuring.

I also think your start and end dates may not be right in your original
code.  I would assume the bars should start the week of the task and not
the following week if a task starts in the middle of the week.

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

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

  '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

  Call makechart(RowCount, minheaderdatecolumn, _
  maxheaderdatecolumn)

  Next RowCount

  End Sub

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

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

  'format dates
  With GanttRange

  .Interior.ColorIndex= 3
  .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
  .Interior.ColorIndex= 3
  .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/showthread.php?t=186842

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

Hi Joel,

Fantastic work - code is very nearly perfect!!!

The only issue I've encountered is that for the first promo in Row 2,
the code seems to using the start date for the event on Row 3, and the
end date of the entire date range (i.e. as per the sample event data I
gave you, Mar22 is shown as being between 05/03/2010 and 16/04/2010).
The code is perfect for subsequent rows however?

Also, is there a way to evaluate the event list in column A, and if
the event description contains the word BULK,
set .Interior.ColorIndex = 6?

Thanks again!!

Cheers
Chris

 

[nofam]

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/showthread.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

 

[nofam]

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

 

[nofam]

I'm at work and the site where yo placed the workbook is blocked.  I
added a summarry bar at the top of the chart.  If you start your dates
at the 3rd row instead of the 2nd row it will fix the problem and add a
summary bar at the top.

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

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

Hi Joel,

Makes perfect sense now - sorry I didn't pick this up sooner. Have
moved the dates down as you suggested and it works fine!

Looking at the chart now it's working, the only other thing that would
improve it is the addition of 'guide lines' to make it a little easier
to read; i.e. for each event, have
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous added from
the event name in Column A to the first date in the red/yellow bar -
just makes it easier to track which event name relates to which bar
when it's printed on an A1 page.

Thanks again
Chris