Employee hours per hour, please help!

[WarWabbit]

Hi all,
I've found some code which i'm using for a staff scheduling system. It can turn strings such as 12pm-5pm into time and then work out the hours which is great, it will also add them up for any given working week. However, what I really need is some more code that will count down the rows rather than the columns and give me a total employee count per hour.

For instance, I have 3 employees - A, B, and C.

Name	Monday
A	11am - 3pm
B	12pm - 6pm
C	12pm - 9pm

<tbody>
</tbody>

What I'd like to be able to do for any given day is have a count for how many hours are being spent, per hour. So using the above table it would count 1 hour for 11am-12pm, 3 hours from 12pm -1pm, etc.



Please see the current code below, if you can see a way I can extrapolate the data I need from the data already created then I'd be really grateful, my VBA skills are very limited as I only delve into it when standard formulas won't cut it. I appreciate any help that you guys and gals can give.

[COLOR=#333333]Function Hours(rng As Range)[/COLOR]<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">
    Hours = GetCellHours(rng)

End Function

Function Pay(rng As Range)
    
    Pay = rng(3) * rng(5)
    
End Function



Function GetCellHours(rng As Range)

    Dim cell As Range
    Dim Hours As Double
    
    For Each cell In rng
        If cell.Column >= 7 Then
        
            If cell.Text <> "" Then
                Dim lines() As String
                Dim line
                lines = Split(Replace(cell.Text, "/", vbLf), vbLf)
                For Each line In lines
                    Hours = Hours + GetLineHours(CStr(line))
                Next line
            Else
                If rng.Worksheet.Cells(5, cell.Column).Text = "" Then
                    GoTo Finish
                End If
            End If
        
        End If
    Next cell
    
    
Finish:
    
    If Hours < 0 Then Hours = 0
    
    GetCellHours = Hours

End Function

Function GetLineHours(str As String)

    Dim Hours As Double
    
    
    On Error GoTo NoHours
    
    If str = Null Then GoTo NoHours
    If str = "" Then GoTo NoHours
    str = Trim(str)
    If str = "" Then GoTo NoHours
  
    Dim words() As String
    
    If InStr(str, "-") Then
        
        words = Split(str, "-")
        
        If UBound(words) + 1 = 2 Then
        
            Dim start As Date
            start = CDate(words(0))
            
            Dim Finish As Date
            Finish = CDate(words(1))
            
            Hours = 24 * (Finish - start)
        
            If Hours <= 0 Then
                Hours = Hours + 24
            End If
        
        End If
        
    ElseIf InStr(str, " ") Then
    
        words = Split(str)
        
        If UBound(words) + 1 = 3 Then
            If words(2) = "break" Then
                Dim amount As Double
                amount = CDbl(words(0))
                Dim interval As String
                interval = words(1)
                
                If interval = "minute" Or interval = "min" Or interval = "mins" Then
                    amount = (amount / 60)
                ElseIf interval = "hours" Or interval = "hour" Or interval = "hr" Or interval = "hrs" Then
                Else
                    amount = 0
                End If
                
                Hours = -amount
            End If
        End If
        
        If UBound(words) + 1 = 2 Then
            If words(1) = "hours" Or words(1) = "hour" Then
        
                Hours = CDbl(words(0))

            End If
        End If
        
    End If
    
    GoTo NoError

NoHours:
    Hours = 0

NoError:
    GetLineHours = Hours
     </code>[COLOR=#333333]End Function[/COLOR]

Ideally some kind of countif procedure as it converts the strings in to time and works out the overall hours would be preferable, but having to have a separate function or even module would be just fine too. I'd just like to get out this hole i'm in so I can finish my project.
I couldn't find a way to upload the excel file so please find it here if required.
Thanks,
~Wabbit

 

[HackSlash]

First up, I want to say that this is impossible to read because you have a Function called "Hours" and then you have a bunch of local variables called "Hours". You don't want to do this because a function will return a value just like a variable will and results in an ambiguous state. Most programming languages won't allow you to do this.

Next up, I can tell that your Hours function calls another function and passes the range that was passed to it. This appears to be redundant. I believe that any place you call Hours, you could be calling GetCellHours. Please correct me if there is a reason for this.

My recommendation is to begin by putting "Option Explicit" at the very top of your code window, before any subroutines.

Option Explicit

Then fix any compile errors you get.

Now remove the "Function Hours" and replace all references with "GetCellHours"

Come back once you have that running and it will be much easier to troubleshoot.