CODEWITHSUNDEEP
vbaexcel
user3306637
user3306637

Reputation: 11

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

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!

Upvotes: 1

Views: 78

Answers (2)

aPhilRa
aPhilRa

Reputation: 157

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

Upvotes: 0

Mrig
Mrig

Reputation: 11702

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

Upvotes: 1

Related Questions