craigwg
07-18-2008, 10:21 AM
Hi,My problem is that I think I don't know what my problem is! I have been working on a time sheet to track hours and I have a great button that runs a report for me. The report states how many hours I worked today, this week, and ALL hours. Its the ALL hours figure I'm having troubles with.One issue was trying to make Excel identify the total hours. Long story short I am doing this with color (e.g. my weekly hours are have a blue background). So I found a cool UDF (User Defined Function) that conditionally sums values of colored cells. the UDF works fantastically when I run it manually. It accepts two arguments, the range of cells I want to add, and the range that holds the sample color. One obstacle I have solved is how to run a regular function in VBA. I have all ready discovered the wonders of the command "WorksheetFunction". My problem is that when I attempt to do this with the UDF I get the old "Run Time Errer 438: Object doesn't support this property or method". Which is no help to me!I have been combing through forums and advice. I have a hint that the problem may have something to do with data types. For example the UDF is asking for two ranges. But I'm about to throw that theory out because I have entered it as ranges to the best of my ability and I get the same error message.That said, here is the code of the UDF, as well as the code of my creation. I have added comments to my code. Any help would be...as they say in California...FREAKIN' AWESOME!!!!
Here is the UDF
Function SumByColor(InputRange As Range, ColorRange As Range) As Double
' returns the sum of each cell in the range InputRange that has the same
' background color as the cell in ColorRange
' example: =SumByColor($A$1:$A$20,B1)
' range A1:A20 is the range you want to sum
' range B1 is a cell with the background color you want to sum
Dim cl As Range, TempSum As Double, ColorIndex As Integer
' Application.Volatile ' this is optional
ColorIndex = ColorRange.Cells(1, 1).Interior.ColorIndex
TempSum = 0
On Error Resume Next ' ignore cells without values
For Each cl In InputRange.Cells
If cl.Interior.ColorIndex = ColorIndex Then
TempSum = TempSum + cl.Value
End If
Next cl
On Error GoTo 0
Set cl = Nothing
SumByColor = TempSum
End Function
And here is my code with comments. My problem is appearing near the end of this code, the rest is fine (tested and working great).
Public Sub RunReport()
' Display report of weekly stats
Dim WeeklyHours, DailyHours, TotalHours, Msg2, Style2, Title2, Response2, MyColumn, MyRow, MyTime
MyTime = Left(Time, 4)
MoveToToday
MyColumn = ActiveCell.Column
MyRow = ActiveCell.Row
Select Case MyColumn
Case 3
MyColumn = "C"
ActiveCell.Offset(0, 4).Activate
Case 4
MyColumn = "D"
ActiveCell.Offset(0, 3).Activate
Case 5
MyColumn = "E"
ActiveCell.Offset(0, 2).Activate
Case 6
MyColumn = "F"
ActiveCell.Offset(0, 1).Activate
Case Else
End Select
DailyHours = Round(ActiveCell.Value * 24, 1)
WeeklyHours = Round(Range("G8").Value, 1) ' Sets value of week hours
TotalHours = Round(WorksheetFunction.SumByColor(Worksheets(1).Range("G1:G1000"), "G8"), 1)
' This one should work fine, its based on a UDF (see below) that works fine. Just can't make it work in VBA.
' TotalHours = Round(WorksheetFunction.SumIf(Worksheets(1).Range("G:G"), ">10", Range("G:G")), 1)
' Cheater way to dynamically add all the total week's hours. It's cheater because it conditionally
' adds only numbers greater than 10.
Msg2 = "Here is your Timesheet summary." & vbCrLf & vbCrLf & _
"Total hours worked today = " & DailyHours & "." & vbCrLf & _
"Total hours worked this week = " & WeeklyHours & "." & vbCrLf & _
"Total hours ever = " & TotalHours & "."
Style2 = vbOKOnly + vbExclamation + vbDefaultButon1
Title2 = "Report"
Response2 = MsgBox(Msg2, Style2, Title2)
End Sub
Here is the UDF
Function SumByColor(InputRange As Range, ColorRange As Range) As Double
' returns the sum of each cell in the range InputRange that has the same
' background color as the cell in ColorRange
' example: =SumByColor($A$1:$A$20,B1)
' range A1:A20 is the range you want to sum
' range B1 is a cell with the background color you want to sum
Dim cl As Range, TempSum As Double, ColorIndex As Integer
' Application.Volatile ' this is optional
ColorIndex = ColorRange.Cells(1, 1).Interior.ColorIndex
TempSum = 0
On Error Resume Next ' ignore cells without values
For Each cl In InputRange.Cells
If cl.Interior.ColorIndex = ColorIndex Then
TempSum = TempSum + cl.Value
End If
Next cl
On Error GoTo 0
Set cl = Nothing
SumByColor = TempSum
End Function
And here is my code with comments. My problem is appearing near the end of this code, the rest is fine (tested and working great).
Public Sub RunReport()
' Display report of weekly stats
Dim WeeklyHours, DailyHours, TotalHours, Msg2, Style2, Title2, Response2, MyColumn, MyRow, MyTime
MyTime = Left(Time, 4)
MoveToToday
MyColumn = ActiveCell.Column
MyRow = ActiveCell.Row
Select Case MyColumn
Case 3
MyColumn = "C"
ActiveCell.Offset(0, 4).Activate
Case 4
MyColumn = "D"
ActiveCell.Offset(0, 3).Activate
Case 5
MyColumn = "E"
ActiveCell.Offset(0, 2).Activate
Case 6
MyColumn = "F"
ActiveCell.Offset(0, 1).Activate
Case Else
End Select
DailyHours = Round(ActiveCell.Value * 24, 1)
WeeklyHours = Round(Range("G8").Value, 1) ' Sets value of week hours
TotalHours = Round(WorksheetFunction.SumByColor(Worksheets(1).Range("G1:G1000"), "G8"), 1)
' This one should work fine, its based on a UDF (see below) that works fine. Just can't make it work in VBA.
' TotalHours = Round(WorksheetFunction.SumIf(Worksheets(1).Range("G:G"), ">10", Range("G:G")), 1)
' Cheater way to dynamically add all the total week's hours. It's cheater because it conditionally
' adds only numbers greater than 10.
Msg2 = "Here is your Timesheet summary." & vbCrLf & vbCrLf & _
"Total hours worked today = " & DailyHours & "." & vbCrLf & _
"Total hours worked this week = " & WeeklyHours & "." & vbCrLf & _
"Total hours ever = " & TotalHours & "."
Style2 = vbOKOnly + vbExclamation + vbDefaultButon1
Title2 = "Report"
Response2 = MsgBox(Msg2, Style2, Title2)
End Sub