PDA

View Full Version : Running a User Defined Function in VBA



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

TomSchreiner
07-18-2008, 10:30 AM
Made correction...

TotalHours = Round(SumByColor(Worksheets(1).Range("G1:G1000"), Worksheets(1).Range("G8")), 1)

SumByColor is your creation; not a member of the WorksheetFunction class.
"G8" is simply a string. It will not be coerced into a range...

craigwg
07-18-2008, 10:53 AM
Thanks! This nailed it! I thought WorksheetFunction was how you could run anything. Apparently it is only how you run ALL predefined functions but now UDFs. Is that true?

Thanks again,
Craig.

mdmackillop
07-18-2008, 11:18 AM
Tidied up a couple of bits.

Sub timestamp()
' This takes the current dynamic date and returns it as a static date
ActiveCell = Format(Now, "hh:mm:ss AMPM")
End Sub

Sub NewWeek()
' Creates a blank timesheet for a new week

With Range("A1:I9")
.Copy
.Insert Shift:=xlDown
End With
Range("C2:G6").ClearContents
With Range("A2:A6")
.Value = 7
.Offset(9).Copy
.PasteSpecial Operation:=xlAdd
End With
Range("C2").Select
End Sub

mdmackillop
07-18-2008, 11:20 AM
A UDF by definition is not a worksheet function, so you just refer to it directly.

Bob Phillips
07-18-2008, 11:27 AM
Thanks! This nailed it! I thought WorksheetFunction was how you could run anything. Apparently it is only how you run ALL predefined functions but now UDFs. Is that true?

Not all functions, only those in the WorksheetFunction object, and not in array formulae

mdmackillop
07-18-2008, 11:42 AM
For B2 etc. try =TEXT(A2,"dddd")

craigwg
07-18-2008, 12:35 PM
That's pretty cool. I fought my formula for days to get it to work right. If I can't get it to work logically the first time I tend to increase the complexity of the problem. Sometimes I solve it, but this is the result.

Thank you sir. I owe you a coke.

Craig

mdmackillop
07-18-2008, 02:52 PM
That's pretty cool. I fought my formula for days to get it to work right. If I can't get it to work logically the first time I tend to increase the complexity of the problem. Sometimes I solve it, but this is the result.
Been there and done that. Eventually it all comes together.
Regards
MD