extract data

[Afarag]

Dears,

I ask for help, that I have some data in one column like that
35515Mai Mohamed Shebl83... 7:00 AM 4:00 PM
and I have the code which extract the time "7:00 AM 4:00 PM"
and I have some row that contain the words "D" and "Annual" at the last of row words that I need to extract it also, I ask to edit the below code to get it
38357Noura Ezzat Ibrahim838...Do
39042Samar Alam Abd El Azi...Annual

Option Explicit
Sub ExtrTime()
    Dim RE As Object, MC As Object, M As Object
    Dim vSrc As Variant, vRes() As Variant
    Dim rRes As Range
    Dim I As Long
    Dim S As String
   
'Get Source Data
vSrc = Range("a1", Cells(Rows.Count, "A").End(xlUp))

'Set Results Range and array
Set rRes = Range("B1").Resize(UBound(vSrc))
ReDim vRes(1 To UBound(vSrc), 1 To 1)

'Regular Expression Engine
Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .ignorecase = False
    .Pattern = "\b((?:1[0-2]|\d):[0-5]\d\s+[AP]M)"
End With

'Extract times
For I = 1 To UBound(vSrc)
    S = vSrc(I, 1)
    If RE.test(S) Then
        Set MC = RE.Execute(S)
        For Each M In MC
            vRes(I, 1) = vRes(I, 1) & Space(1) & M
        Next M
        vSrc(I, 1) = Trim(vSrc(I, 1))
    End If
Next I

rRes = vRes

End Sub

 

[Luke M]

Here you go. Two If statements added near the end.

 Sub ExtrTime()
     Dim RE As Object, MC As Object, M As Object
     Dim vSrc As Variant, vRes() As Variant
     Dim rRes As Range
     Dim I As Long
     Dim S As String
     
 'Get Source Data
 vSrc = Range("a1", Cells(Rows.Count, "A").End(xlUp))

 'Set Results Range and array
 Set rRes = Range("B1").Resize(UBound(vSrc))
 ReDim vRes(1 To UBound(vSrc), 1 To 1)

 'Regular Expression Engine
 Set RE = CreateObject("vbscript.regexp")
 With RE
     .Global = True
     .ignorecase = False
     .Pattern = "\b((?:1[0-2]|\d):[0-5]\d\s+[AP]M)"
 End With

 'Extract times
 For I = 1 To UBound(vSrc)
     S = vSrc(I, 1)
     If RE.test(S) Then
         Set MC = RE.Execute(S)
         For Each M In MC
             vRes(I, 1) = vRes(I, 1) & Space(1) & M
         Next M
         vSrc(I, 1) = Trim(vSrc(I, 1))
     ElseIf UCase(Right(vSrc(I, 1), 2)) = "DO" Then
        vRes(I, 1) = "Do"
     ElseIf UCase(Right(vSrc(I, 1), 6)) = "ANNUAL" Then
        vRes(I, 1) = "Annual"
     
     End If
 Next I

 rRes = vRes

 End Sub

 

[Afarag]

@Luke M

great effort you are doing, thanks a lot

and many thanks for the great helpful knowledge appears in this thread, that contain a lot of useful info about both VBA and Excel tech..

http://chandoo.org/forum/threads/ho...th-data-from-multiple-other-worksheets.15000/

but what I look for to know is the security box for sign on, can you replay the code or the way to can use it, with the disable or enable ribbon feature and if PS W not correct I'll direct to another sheet

Thank you for your patience and for your value

 

[Luke M]

Thanks Afarag, and glad the other thread is helping so many. Here's a copy of the latest version of the file. Password to unlock the VB is "Chandoo". In there, check out the modules called "Security" and "RibbonCalls" and the User Form. That is where the bulk of the code you're interested in is at. The Super Admin sheet has some event macros as well. To access the Super Admin worksheet, a popup may appear. Use username "ma" and password "pwd1"

The project has gone through many changes, but hopefully reading through the thread, and the comments I put in the VB, someone can follow along.