Write to Myrange.Value not working for me

D

dt192

New Member
Joined
Jun 14, 2015
Messages
17
Hi all,

I'm trying to write to the referenced cell Myrange.Value on the last line. The message box does display the correct value.

Thanks In advance for the help.

Daniel

Code: 
Option Compare Text
Function formatHours(Myrange As Range) As String
    Dim strInput, strPattern, StartPeriod, EndPeriod As String
    Dim StartHour, StartMinute, EndHour, EndMinute, BreakLength As Integer


    Dim RegEx: Set RegEx = New RegExp
    With RegEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = strPattern
    End With
    RegEx.Pattern = "^(\d+):?(\d+)?(AM|PM)? (\d+):?(\d+)?(AM|PM)? ?(\d+)?"
    
    strInput = Myrange.Value


    Set matches = RegEx.Execute(strInput)
    
    If matches.Count <> 0 Then
        
        
        
        StartMinute = 0
        StartPeriod = "AM"
        EndMinute = 0
        EndPeriod = "PM"
        BreakLength = 0
            
            
            
        StartHour = matches(0).SubMatches(0)
        
        If matches(0).SubMatches(1) <> "" Then
            StartMinute = matches(0).SubMatches(1)
        End If
        
        If matches(0).SubMatches(2) <> "" Then
            StartPeriod = matches(0).SubMatches(2)
        End If
        
        If StartPeriod = "PM" Then
            StartHour = StartHour + 12
        End If
        
        
        
        EndHour = matches(0).SubMatches(3)
        
        If matches(0).SubMatches(4) <> "" Then
            EndMinute = matches(0).SubMatches(4)
        End If


        If matches(0).SubMatches(5) <> "" Then
            EndPeriod = matches(0).SubMatches(5)
        End If
        
        If matches(0).SubMatches(6) <> "" Then
            BreakLength = matches(0).SubMatches(6)
        End If
        
        If EndPeriod = "PM" Then
            EndHour = EndHour + 12
        End If
        
        
        
        
        StartTime = TimeSerial(StartHour, StartMinute, 0)
        EndTime = TimeSerial(0, ((EndHour * 60) + EndMinute) - BreakLength, 0)
        formatHours = Round((DateDiff("n", StartTime, EndTime) / 60), 2)
        
        EndTime = TimeSerial(EndHour, EndMinute, 0)
        MsgBox (Left(StartTime, 5) & "-" & Left(EndTime, 5))
        Myrange.Value = Left(StartTime, 5) & "-" & Left(EndTime, 5)
        
    End If
End Function
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
A function cannot alter the value in another cell. Look in the 'More Information' section here.
 
Upvote 0
Hi,

Thanks.

I thought it may be something like that.

Would putting this script in 'change' and watching the ranges of cells be the best solution? are there any other ways around this?
 
Last edited:
Upvote 0
Please explain clearly in words what you are trying to achieve.
 
Upvote 0
Peter_SSs said:
Please explain clearly in words what you are trying to achieve.
Click to expand...

The idea is to type '9 6 30' in cell B3 for example, it then auto updates to show '9:00-18:00' in cell B3 and '8.5' in cell C3. It's to help out the guy that does payroll.

I have moved the code to a change event and all seems to be well now.

Many thanks for the help Peter.

Final code:
Code: 
Option Compare Text
Private Sub Worksheet_Change(ByVal MyRange As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("B:B,D:D,F:F,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X,Z:Z")
    
    If Not Application.Intersect(KeyCells, Range(MyRange.Address)) Is Nothing Then
        
        Dim strInput, strPattern, StartPeriod, EndPeriod As String
        Dim StartHour, StartMinute, EndHour, EndMinute, BreakLength As Integer
    
        Dim RegEx: Set RegEx = New RegExp
        With RegEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .Pattern = strPattern
        End With
        RegEx.Pattern = "^(\d+):?(\d+)?(AM|PM)? (\d+):?(\d+)?(AM|PM)? ?(\d+)?"
        
        strInput = MyRange.Value
    
        Set matches = RegEx.Execute(strInput)
        
        If matches.Count <> 0 Then
                
            StartMinute = 0
            StartPeriod = "AM"
            EndMinute = 0
            EndPeriod = "PM"
            BreakLength = 0
            
            
            StartHour = matches(0).SubMatches(0)
            
            If matches(0).SubMatches(1) <> "" Then
                StartMinute = matches(0).SubMatches(1)
            End If
            
            If matches(0).SubMatches(2) <> "" Then
                StartPeriod = matches(0).SubMatches(2)
            End If
            
            If StartPeriod = "PM" Then
                StartHour = StartHour + 12
            End If
        
       
            EndHour = matches(0).SubMatches(3)
            
            If matches(0).SubMatches(4) <> "" Then
                EndMinute = matches(0).SubMatches(4)
            End If
    
            If matches(0).SubMatches(5) <> "" Then
                EndPeriod = matches(0).SubMatches(5)
            End If
            
            If matches(0).SubMatches(6) <> "" Then
                BreakLength = matches(0).SubMatches(6)
            End If
            
            If EndPeriod = "PM" Then
                EndHour = EndHour + 12
            End If
              
        
            StartTime = TimeSerial(StartHour, StartMinute, 0)
            EndTime = TimeSerial(0, ((EndHour * 60) + EndMinute) - BreakLength, 0)
            MyRange.Offset(, 1).Value = Round((DateDiff("n", StartTime, EndTime) / 60), 2)
         
            EndTime = TimeSerial(EndHour, EndMinute, 0)
            MyRange.Value = Left(StartTime, 5) & "-" & Left(EndTime, 5)
        
        End If
    End If
End Sub
 
Upvote 0
dt192 said:
I have moved the code to a change event and all seems to be well now.
Click to expand...
Good news.

I haven't studied your code in detail, but note that the following line only declares EndPeriod as string. All the other variables in that line will be Variant type.
Code: 
Dim strInput, strPattern, StartPeriod, EndPeriod As String
If you want them all to be String type, then you need to specify each one as follows
Code: 
Dim strInput As String, strPattern As String, StartPeriod As String, EndPeriod As String
 
Upvote 0
Thanks Peter. I have corrected this now.

I also realised that the script crashed if I deleted multiple cells, so added some handling for that.

Code: 
Option Compare Text
Private Sub Worksheet_Change(ByVal MyRange As Range)
    Dim strInput As String, strPattern As String, StartPeriod As String, EndPeriod As String
    Dim StartHour As Integer, StartMinute As Integer, EndHour As Integer, EndMinute As Integer, BreakLength As Integer
    Dim KeyCells As Range, rCell As Range
    
    Set KeyCells = Range("B:B,D:D,F:F,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X,Z:Z")
    
    If Not Application.Intersect(KeyCells, Range(MyRange.Address)) Is Nothing Then
        
        Dim RegEx: Set RegEx = New RegExp
        With RegEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .Pattern = strPattern
        End With
        RegEx.Pattern = "^(\d+):?(\d+)?(AM|PM)? (\d+):?(\d+)?(AM|PM)? ?(\d+)?"
        
        For Each rCell In MyRange.Cells
    
            strInput = rCell.Value
            Set matches = RegEx.Execute(strInput)
            
            If matches.Count <> 0 Then
                    
                StartMinute = 0
                StartPeriod = "AM"
                EndMinute = 0
                EndPeriod = "PM"
                BreakLength = 0
                
                
                StartHour = matches(0).SubMatches(0)
                
                If matches(0).SubMatches(1) <> "" Then
                    StartMinute = matches(0).SubMatches(1)
                End If
                
                If matches(0).SubMatches(2) <> "" Then
                    StartPeriod = matches(0).SubMatches(2)
                End If
                
                If StartPeriod = "PM" Then
                    StartHour = StartHour + 12
                End If
            
           
                EndHour = matches(0).SubMatches(3)
                
                If matches(0).SubMatches(4) <> "" Then
                    EndMinute = matches(0).SubMatches(4)
                End If
        
                If matches(0).SubMatches(5) <> "" Then
                    EndPeriod = matches(0).SubMatches(5)
                End If
                
                If matches(0).SubMatches(6) <> "" Then
                    BreakLength = matches(0).SubMatches(6)
                End If
                
                If EndPeriod = "PM" Then
                    EndHour = EndHour + 12
                End If
                  
            
                StartTime = TimeSerial(StartHour, StartMinute, 0)
                EndTime = TimeSerial(0, ((EndHour * 60) + EndMinute) - BreakLength, 0)
                rCell.Offset(, 1).Value = Round((DateDiff("n", StartTime, EndTime) / 60), 2)
             
                EndTime = TimeSerial(EndHour, EndMinute, 0)
                rCell.Value = Left(StartTime, 5) & "-" & Left(EndTime, 5)
            End If
        Next rCell
    End If
End Sub
 
Upvote 0
dt192 said:
I also realised that the script crashed if I deleted multiple cells, ...
Click to expand...
Yes, I was getting to that. :)

One more quite minor thing. Integer variables get converted to Long before use, so you might as well ..
- save that conversion process, and
- save yourself 3 characters of typing for each one
.. by declaring them as Long to start with. :)
 
Upvote 0
Peter_SSs said:
Yes, I was getting to that. :)

One more quite minor thing. Integer variables get converted to Long before use, so you might as well ..
- save that conversion process, and
- save yourself 3 characters of typing for each one
.. by declaring them as Long to start with. :)
Click to expand...

Thanks. That's updated.

I also realised midnight was converting the time to a date due to feeding TimeSerial '24' as the hour rather than 0.

Code: 
Option Compare Text
Private Sub Worksheet_Change(ByVal MyRange As Range)
    Dim strInput As String, strPattern As String, StartPeriod As String, EndPeriod As String, StartTime As String, EndTime As String
    Dim StartHour As Long, StartMinute As Long, EndHour As Long, EndMinute As Long, BreakLength As Long
    Dim KeyCells As Range, rCell As Range
    
    Set KeyCells = Range("B:B,D:D,F:F,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X,Z:Z")
    
    If Not Application.Intersect(KeyCells, Range(MyRange.Address)) Is Nothing Then
        
        Dim RegEx: Set RegEx = New RegExp
        With RegEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .Pattern = strPattern
        End With
        RegEx.Pattern = "^(\d+):?(\d+)?(AM|PM)? (\d+):?(\d+)?(AM|PM)? ?(\d+)?"
        
        For Each rCell In MyRange.Cells
    
            strInput = rCell.Value
            Set matches = RegEx.Execute(strInput)
            
            If matches.Count <> 0 Then
                    
                StartMinute = 0
                StartPeriod = "AM"
                EndMinute = 0
                EndPeriod = "PM"
                BreakLength = 0
                
                
                StartHour = matches(0).SubMatches(0)
                
                If matches(0).SubMatches(1) <> "" Then
                    StartMinute = matches(0).SubMatches(1)
                End If
                
                If matches(0).SubMatches(2) <> "" Then
                    StartPeriod = matches(0).SubMatches(2)
                End If
                
                If StartPeriod = "AM" And StartHour = 12 Then
                    StartHour = 0
                End If
                
                If StartPeriod = "PM" And EndHour < 12 Then
                    StartHour = StartHour + 12
                End If
                
                
                                
                EndHour = matches(0).SubMatches(3)
                
                If matches(0).SubMatches(4) <> "" Then
                    EndMinute = matches(0).SubMatches(4)
                End If
        
                If matches(0).SubMatches(5) <> "" Then
                    EndPeriod = matches(0).SubMatches(5)
                End If
                
                If matches(0).SubMatches(6) <> "" Then
                    BreakLength = matches(0).SubMatches(6)
                End If
                
                If EndPeriod = "AM" And EndHour = 12 Then
                    EndHour = 0
                End If
                
                If EndPeriod = "PM" And EndHour < 12 Then
                    EndHour = EndHour + 12
                End If
                
            
                StartTime = TimeSerial(StartHour, StartMinute, 0)
                EndTime = TimeSerial(EndHour, EndMinute, 0)
                
                WorkHours = Round((DateDiff("n", StartTime, EndTime) / 60), 2)
                If WorkHours < 0 Then
                    WorkHours = WorkHours + 24
                End If
                
                rCell.Value = Left(StartTime, 5) & "-" & Left(EndTime, 5)
                rCell.Offset(, 1).Value = WorkHours - (BreakLength / 60)
                
            End If
        Next rCell
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA for sending e-mails
Replies
5
Views
481
Micron
M
T
  • Question
Excel File not working on one computer but will on another.
2 3
Replies
20
Views
7K
TrainerBlue
T
G
  • Question
Can you tell me why the VBA scraper code doesn't work?
Replies
1
Views
2K
Dan_W
D
K
  • Question
VBA Code To Parse and Evaluate Various Feet and Inch Notations For Peer Review
Replies
1
Views
3K
Kcd2018
K
S
  • Question
GetDistance Function Stopped Working
Replies
7
Views
3K
scotball
S

Forum statistics

Threads
1,214,990
Messages
6,122,625
Members
449,093
Latest member
catterz66

Share this page

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
Back
Top