Running a User Defined Function in VBA
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
[vba]
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
[/vba]
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).
[vba]
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
[/vba]
