Search in cell full of text an hour and copy the hour to other cell in VBA

Question

I've goot an data base with 1200 rows that I want to search an hour in cell full of notes and copy the specific hour to another cell.

for exemple, in cell I've a data like this: "I wait to the bus in the bus stop for the ride of 6:45 and the ride did'nt stop"

What I've got is this:

Sub Find()
irow = 2
    Do Until IsEmpty(Cells(irow, 34))
        If Cells(irow, 34).Value Like "*[0-23]:[0-59]*" = True Then
            Cells(irow, 34).Value = Cells(irow, 37).Value
            irow = irow + 1
        Else
            irow = irow + 1
        End If
    Loop
End Sub

Thanks!

Mrig · Answer 1 · 2016-06-28T10:52:33.593

Instead of

If Cells(irow, 34).Value Like "*[0-23]:[0-59]*" = True Then

try

If Cells(irow, 34).Value Like "*#:##*" Then

You can also use following code:

Sub Find()
    Dim i As Integer
    Dim arr() As String

    irow = 2
    Do Until IsEmpty(Cells(irow, 34))
        arr = Split(Cells(irow, 34), " ")
        For i = LBound(arr) To UBound(arr)
            If IsTime(arr(i)) Then
                'to get the hour
                MsgBox Left(arr(i), Application.WorksheetFunction.Find(":", arr(i)) - 1)
                Cells(irow, 34).Value = Cells(irow, 37).Value
                Exit For
            End If
        Next
        irow = irow + 1
    Loop
End Sub

Function IsTime(strData As String) As Boolean
    On Error Resume Next
    IsTime = TimeValue(strData)
End Function

aPhilRa · Accepted Answer · 2016-06-28T13:58:56.340

The following code finds a timestamps in a text and writes it into a separate column on the same row. However it assumes that only one sequence of "[digit][digit]:[digit][digit]" exists. If your input can have multiple of those you might need some additional filter criteria.

But first you need to make sure that you have Regular Expressions activated in your VBA project. (see here)

Sub Find()
    my_row = 1
    my_column = 1
    Dim regEx As New RegExp
    regEx.Pattern = "\d*\d:\d\d"
    regEx.IgnoreCase = True 'True to ignore case
    regEx.Global = True 'True matches all occurances, False matches the first occura
    Do Until IsEmpty(Cells(my_row, my_column))
        If regEx.Test(Cells(my_row, my_column)) Then
            Debug.Print ("Found something")
            Dim matches
            Set matches = regEx.Execute(Cells(my_row, my_column))
            If matches.Count = 1 Then
                Cells(my_row, my_column + 2).Value = matches(0).Value
            Else
                Debug.Print ("Warning more than one match found")
            End If
        Else
            Debug.Print ("Nothing found")
        End If
        my_row = my_row + 1
    Loop
End Sub

I used the following lines to test the code:

I wait to the bus in the bus a92ohr2902 stop for the ride of 6:58 and the ride did'nt stop
I wait to the bus in the bus ;3;23576;80-934 stop for the ride of 6:59 and the ride did'nt stop
I wait to the bus in the bus 2016-06-01 stop for the ride of 14:00 and the ride did'nt stop
I wait to the bus in the bus 9023845 stop for the ride of 14:01 and the ride did'nt stop
I wait to the bus in the bus ;3;23576;80-934 stop for the ride of 20:50 and the ride did'nt stop
I wait to the bus in the bus 2016-06-01 stop for the ride of 20:59 and the ride did'nt stop
I wait to the bus in the bus 9023845 stop for the ride of 21:00 and the ride did'nt stop
I wait to the bus in the bus a92ohr2902 stop for the ride of 21:01 and the ride did'nt stop

it seems good but if i've got in specific cell other number? like this: "I wait to the bus 254 in the bus stop for the ride of 6:57 and the ride did'nt stop" — user3306637, Jun 28 '16 at 09:45
@user3306637 True, in that case the code supplied by [Mrig](http://stackoverflow.com/a/38072190/637466) seems to do a better job of separating timestamps from other numbers. — aPhilRa, Jun 28 '16 at 10:30
The code fo Mrig does not work. your code work great, need to check only this issue. — user3306637, Jun 28 '16 at 10:52
@user3306637 since regular expressions are available to you, I simplified my code. Now ExtractTimeStamp is no longer necessary. — aPhilRa, Jun 28 '16 at 13:59

Search in cell full of text an hour and copy the hour to other cell in VBA

2 Answers2