Here is what I've come up with so far. I'm sure the "special case" of the
begining of the year is not quite right. As well as, I'm sure there is a
more elegant solution that I cannot see.

Thanks for the help,

Chris

Code:

Sub GetGraphData()
Dim ThisWeek As Integer, ThisWeekCounter As Integer
Dim Week2 As Integer, Week2Counter As Integer
Dim Week3 As Integer, Week3Counter As Integer
Dim Week4 As Integer, Week4Counter As Integer
Dim Week5 As Integer, Week5Counter As Integer
Dim Week6 As Integer, Week6Counter As Integer
Dim Week7 As Integer, Week7Counter As Integer
Dim Week8 As Integer, Week8Counter As Integer

'Variables for special case
Dim CurrDate As Date
Dim offset As Integer

'initialize counters to zero
ThisWeekCounter = 0
Week2Counter = 0
Week3Counter = 0
Week4Counter = 0
Week5Counter = 0
Week6Counter = 0
Week7Counter = 0
Week8Counter = 0

'Get this week's week number
ThisWeek = VBAWeekNum(Now, 2) 'days begin on Monday and end on Sunday

If ThisWeek < 8 Then 'This is the begining of the year, special case
Dim rng As Range
Dim i As Integer

For i = 45 To LastCell(Worksheets(NewSheetname)).row
Set rng = Worksheets(NewSheetname).Cells(i, 2)
If ThisWeek < VBAWeekNum(rng.Value, 2) Then

Select Case True

Case 52 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week2Counter = Week2Counter + 1
End If

Case 52 - ThisWeek = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week3Counter = Week3Counter + 1
End If
Case 52 - ThisWeek - 2 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week4Counter = Week4Counter + 1
End If
Case 52 - ThisWeek - 3 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week5Counter = Week5Counter + 1
End If
Case 52 - ThisWeek - 4 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week6Counter = Week6Counter + 1
End If
Case 52 - ThisWeek - 5 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week7Counter = Week7Counter + 1
End If
Case 52 - ThisWeek - 6 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week8Counter = Week8Counter + 1
End If
Case Else

End Select

Else
Select Case True
Case ThisWeek = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
ThisWeekCounter = ThisWeekCounter + 1
CurrDate = rng.Value
End If
Case ThisWeek - 1 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week2Counter = Week2Counter + 1
CurrDate = rng.Value
End If
Case ThisWeek - 2 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week3Counter = Week3Counter + 1
CurrDate = rng.Value
End If
Case ThisWeek - 3 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week4Counter = Week4Counter + 1
CurrDate = rng.Value
End If
Case ThisWeek - 4 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week5Counter = Week5Counter + 1
CurrDate = rng.Value
End If
Case ThisWeek - 5 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week6Counter = Week6Counter + 1
CurrDate = rng.Value
End If
Case ThisWeek - 6 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week7Counter = Week7Counter + 1
CurrDate = rng.Value
End If
Case ThisWeek - 7 = VBAWeekNum(rng.Value, 2)
If rng.Interior.ColorIndex = 0 And _
rng.Interior.ColorIndex < 57 Then
Week8Counter = Week8Counter + 1
CurrDate = rng.Value
End If
Case Else

End Select
End If
Next i
Else 'This is after week 8, handle as normal
Dim rng2 As Range
Dim j As Integer

For j = 45 To LastCell(Worksheets(NewSheetname)).row
Set rng2 = Worksheets(NewSheetname).Cells(j, 2)

Select Case True

Case ThisWeek = VBAWeekNum(rng2.Value, 2)
If rng2.Interior.ColorIndex = 0 And _
rng2.Interior.ColorIndex < 57 Then
ThisWeekCounter = ThisWeekCounter + 1
End If
Case ThisWeek - 1 = VBAWeekNum(rng2.Value, 2)
If rng2.Interior.ColorIndex = 0 And _
rng2.Interior.ColorIndex < 57 Then
Week2Counter = Week2Counter + 1
End If
Case ThisWeek - 2 = VBAWeekNum(rng2.Value, 2)
If rng2.Interior.ColorIndex = 0 And _
rng2.Interior.ColorIndex < 57 Then
Week3Counter = Week3Counter + 1
End If
Case ThisWeek - 3 = VBAWeekNum(rng2.Value, 2)
If rng2.Interior.ColorIndex = 0 And _
rng2.Interior.ColorIndex < 57 Then
Week4Counter = Week4Counter + 1
End If
Case ThisWeek - 4 = VBAWeekNum(rng2.Value, 2)
If rng2.Interior.ColorIndex = 0 And _
rng2.Interior.ColorIndex < 57 Then
Week5Counter = Week5Counter + 1
End If
Case ThisWeek - 5 = VBAWeekNum(rng2.Value, 2)
If rng2.Interior.ColorIndex = 0 And _
rng2.Interior.ColorIndex < 57 Then
Week6Counter = Week6Counter + 1
End If
Case ThisWeek - 6 = VBAWeekNum(rng2.Value, 2)
If rng2.Interior.ColorIndex = 0 And _
rng2.Interior.ColorIndex < 57 Then
Week7Counter = Week7Counter + 1
End If
Case ThisWeek - 7 = VBAWeekNum(rng2.Value, 2)
If rng2.Interior.ColorIndex = 0 And _
rng2.Interior.ColorIndex < 57 Then
Week8Counter = Week8Counter + 1
End If
Case Else

End Select
Next j
End If

Dim rng3 As Range

Set rng3 =
Worksheets(NewSheetname).Cells(LastCell(Worksheets (NewSheetname)).row, 1)

'Heading
rng3.offset(2, 2).Value = "Totals to be Charted"
rng3.offset(2, 2).Font.Bold = True
rng3.offset(2, 2).Font.Italic = True
rng3.offset(2, 2).Font.Underline = xlUnderlineStyleSingle

rng3.offset(2, 3).Value = "Violations"
rng3.offset(2, 3).Font.Bold = True
rng3.offset(2, 3).Font.Italic = True
rng3.offset(2, 3).Font.Underline = xlUnderlineStyleSingle


rng3.offset(3, 2).Value = "This Week"
rng3.offset(3, 3).Value = ThisWeekCounter

rng3.offset(4, 2).Value = "Week 2"
rng3.offset(4, 3).Value = Week2Counter

rng3.offset(5, 2).Value = "Week 3"
rng3.offset(5, 3).Value = Week3Counter

rng3.offset(6, 2).Value = "Week 4"
rng3.offset(6, 3).Value = Week4Counter

rng3.offset(7, 2).Value = "Week 5"
rng3.offset(7, 3).Value = Week5Counter

rng3.offset(8, 2).Value = "Week 6"
rng3.offset(8, 3).Value = Week6Counter

rng3.offset(9, 2).Value = "Week 7"
rng3.offset(9, 3).Value = Week7Counter

rng3.offset(10, 2).Value = "Week 8"
rng3.offset(10, 3).Value = Week8Counter

MakeChart "C" & rng3.offset(2, 3).row & ":" & "D" & rng3.offset(10,
4).row _
, NewSheetname
End Sub

Function VBAWeekNum(D As Date, FW As Integer) As Integer
VBAWeekNum = CInt(Format(D, "ww", FW))
End Function

Sub MakeChart(data As String, NewSheetname As String)

Charts.Add
ActiveChart.ChartType = xl3DColumnClustered
ActiveChart.SetSourceData Source:=Sheets(NewSheetname). _
Range(data), PlotBy:=xlColumns
ActiveChart.Location Whe=xlLocationAsObject, Name:=NewSheetname
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Violations- Last 8 Weeks"
.Axes(xlCategory).HasTitle = False
.Axes(xlSeries).HasTitle = False
.Axes(xlValue).HasTitle = False
End With
With ActiveChart
.HasAxis(xlCategory) = True
.HasAxis(xlSeries) = False
.HasAxis(xlValue) = True

End With
ActiveChart.Axes(xlCategory).CategoryType = xlAutomatic
ActiveChart.HasLegend = False
ActiveChart.HasDataTable = True


ActiveSheet.Shapes(1).Left = Range("B1").Left
ActiveSheet.Shapes(1).Top = Range("B1").Top

ActiveSheet.Shapes(1).ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(1).ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft


End Sub

Function LastCell(ws As Worksheet) As Range
Dim LastRow&, LastCol%

' Error-handling is here in case there is not any
' data in the worksheet

On Error Resume Next

With ws

' Find the last real row

LastRow& = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).row

' Find the last real column

LastCol% = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column

End With

' Finally, initialize a Range object variable for
' the last populated row.

Set LastCell = ws.Cells(LastRow&, LastCol%)

End Function



"Chris" wrote in message
...
Hello,

Although I really appreciate the file you setup, it's not what I want.

I'm looking for a solution in vba code. Additionally, the graph should
treat all bad websites the same, meaning


Name Date URL
Chris 6/16/06 17:13 http://www.myspace.com <red
Chris 6/15/06 15:13 http://www.myspace.com <red
Chris 6/10/06 12:13 http://www.google.com
Chris 6/8/06 16:58 http://www.cpearson.com
Chris 6/5/06 11:04 http://www.hotornot.com <green
Chris 5/17/06 16:58 http://www.cpearson.com
Chris 5/16/06 16:58 http://office.microsoft.com
Chris 5/12/06 16:58 http://www.motobit.com
Chris 5/11/06 16:58 http://www.bored.com <yellow
Chris 4/27/06 16:58 http://www.google.com
Chris 4/26/06 16:36 http://www.google.com



For the week of 6-11-06 to 6-18-06 there are two bad sites. I only use
differant colors to make things easier to read.

I guess I was thinking of using the Now() function to find out whatever
the current date was and contructing the past 8 weeks as seperate
variables. Then counting the number of "bad" websites per each one of
those 8 weeks and constructing the graph from that.

How would I go about doing this?

Thanks,

Chris


"excelent" wrote in message
...
just as inspiration,- u take it from there :-)

http://pmexcelent.dk/BadWeb.xls