VBA Workbook Procedure

swoolsey

New Member
Joined
Oct 15, 2002
Messages
7
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
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Damon Ostrander

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
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

New Member
Joined
Oct 15, 2002
Messages
7
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

MrExcel MVP
Joined
Feb 17, 2002
Messages
4,239
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

New Member
Joined
Oct 15, 2002
Messages
7
Damon, thanks so much for the help. I tried your last suggestion and it works perfectly!
 

Forum statistics

Threads
1,144,310
Messages
5,723,637
Members
422,506
Latest member
mdindas

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top