Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10
Default Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders

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:D").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?
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders


I rewrote the code to make it easier to follow and to make the loops
esier to follow. the selection method you are using makes it difficult
to modify the code. I used intermediate variables so yo don't have to
select cells and use activecells. If yo understand the changes I made
you should be able to accomplish your goals.



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).Range(Selection.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(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 = 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

Loop
'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/sh...d.php?t=186842

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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10
Default Select contiguous cells by ActiveCell.Interior.ColorIndex andapplyborders

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
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders


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/sh...d.php?t=186842

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

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10
Default Select contiguous cells by ActiveCell.Interior.ColorIndex andapplyborders

On Mar 12, 11:52*pm, joel wrote:
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/sh...d.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


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders


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/sh...d.php?t=186842

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

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10
Default Select contiguous cells by ActiveCell.Interior.ColorIndex andapplyborders

On Mar 14, 12:17*am, joel wrote:
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/sh...d.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
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders


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/sh...d.php?t=186842

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

  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10
Default Select contiguous cells by ActiveCell.Interior.ColorIndex andapplyborders

On Mar 14, 10:46*pm, joel wrote:
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/sh...d.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




  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders


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



  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10
Default Select contiguous cells by ActiveCell.Interior.ColorIndex andapplyborders

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


  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10
Default Select contiguous cells by ActiveCell.Interior.ColorIndex andapplyborders

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
  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders


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/sh...d.php?t=186842

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

  #14   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 10
Default Select contiguous cells by ActiveCell.Interior.ColorIndex andapplyborders

On Mar 17, 12:10*am, joel wrote:
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/sh...d.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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
more on interior.colorindex issue bst Excel Programming 4 July 2nd 08 05:43 PM
interior.colorindex does not work? bst Excel Programming 11 June 28th 08 02:05 PM
problem with interior.colorindex Peter Rooney Excel Programming 7 January 20th 06 01:31 PM
Use of Interior.ColorIndex liquidhot Excel Programming 4 June 27th 05 07:22 PM
Testing for Interior.ColorIndex JeffBo Excel Programming 7 May 17th 04 09:41 PM


All times are GMT +1. The time now is 12:22 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"