VBA Workbook Procedure

[swoolsey]

I am trying to create a work scheduling tool using Excel. I want to be able to enter start and end time values and a lunch break value and have Excel automatically calculate the hours worked. Easy enough. However, I want to enable a Workbook VBA procedure to eliminate the need of entering the : for each start and end time cell. I have been experimenting with a routine from Chip P.'s website and am having problems accessing a specific non-contiguous cells in a range.

Below is the code I am experimenting with, the code that is commented out is where I need help.
Thanks for any reply!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim TimeStr As String

' On Error GoTo EndMacro
' If Application.Intersect(Target, Range("B9:U42")) Is Nothing Then
' Exit Sub
' End If

If Target.Cells.Count > 1 Then
Exit Sub
End If
If Target.Value = "" Then
Exit Sub
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub

 

[Damon Ostrander]

Hi swoolsey,

To make this work with your non-contiguous range, just modify

Range("B9:U42")

to refer to your range. For example, say you have as time input cells B4, B9, G2:G6, and Q11. The range would be

Range("B4,B9,G2:G6,Q11")

or just

[B4,B9,G2:G6,Q11]

 

[swoolsey]

Hi Damon,

Thanks for the response.

For the most part, what you said to do works. The problem I am having is that I have 168 start and end time cells(2 cells for each day of the week x 12 employees) and I am having a problem with syntax on entering a range of ranges that long into VBE. I thought you need to have an underscore at the end of each line to connect them together as one range but I keep getting error messages. Below is where I am at with this. An againg, thanks for your help with this.

Steve
-----------------------------------------

The cells between T15:U15 and B18:c18 is where the line break is and where my problem is.

On Error GoTo EndMacro
If Application.Intersect(Target, Range("B9:C9,E9:F9,H9:I9,K9:L9,N9:O9,Q9:R9,T9:U9,B12:C12,E12:F12,H12:I12,K12:L12,N12:O12,Q12:R12,T12:U12,B15:C15,E15:F15,H15:I15,K15:L15,N15:O15,Q15:R15,T15:U15, _
"B18:C18,E18:F18,H18:I18,K18:L18,N18:O18,Q18:R18,T18:U18")) Is Nothing Then"
Exit Sub
End If

 

[Damon Ostrander]

Hi again swoolsey,

Hooboy! That's the longest range string I've ever seen! But nevertheless, there are several ways of breaking it into parts. Using a continuation line should do it, unless there is some sort of limitation on the size of range strings. In order to break the strings into pieces they must be broken into separate strings and concatenated back together with the ampersand character. Here's how that should look:

On Error GoTo EndMacro
If Application.Intersect(Target, Range( _
"B9:C9,E9:F9,H9:I9,K9:L9,N9:O9,Q9:R9," & _
"T9:U9,B12:C12,E12:F12,H12:I12,K12:L12," & _
"N12:O12,Q12:R12,T12:U12,B15:C15,E15:F15," & _
"H15:I15,K15:L15,N15:O15,Q15:R15,T15:U15," & _
"B18:C18,E18:F18,H18:I18,K18:L18," & _
"N18:O18,Q18:R18,T18:U18")) Is Nothing Then
Exit Sub
End If

or you could do it this way:

Const Drange = _
"B9:C9,E9:F9,H9:I9,K9:L9,N9:O9,Q9:R9," & _
"T9:U9,B12:C12,E12:F12,H12:I12,K12:L12," & _
"N12:O12,Q12:R12,T12:U12,B15:C15,E15:F15," & _
"H15:I15,K15:L15,N15:O15,Q15:R15,T15:U15," & _
"B18:C18,E18:F18,H18:I18,K18:L18," & _
"N18:O18,Q18:R18,T18:U18"

On Error GoTo endmacro
If Application.Intersect(Target, Range(Drange)) Is Nothing Then Exit Sub

where putting the range into a constant should make the code run more efficiently since it doesn't have to do the concatenation of the strings each time the event is triggered.

But here is a way that breaks the range check into multiple tests so that the string length does not get too long:

On Error GoTo EndMacro
With Application
If .Intersect(Target, [B9:C9,E9:F9,H9:I9,K9:L9,N9:O9,Q9:R9]) Is Nothing Then
If .Intersect(Target, [T9:U9,B12:C12,E12:F12,H12:I12,K12:L12]) Is Nothing Then
If .Intersect(Target, [N12:O12,Q12:R12,T12:U12,B15:C15,E15:F15]) Is Nothing Then
If .Intersect(Target, [H15:I15,K15:L15,N15:O15,Q15:R15,T15:U15]) Is Nothing Then
If .Intersect(Target, [B18:C18,E18:F18,H18:I18,K18:L18]) Is Nothing Then Exit Sub
End If: End If: End If: End If
End With

 

[swoolsey]

Damon, thanks so much for the help. I tried your last suggestion and it works perfectly!