Extracting Multiple Dates from a single cell - excel

Question

I have a single cell that is including all historical updates, each update displays a date/time stamp and then the user's name before their notes. I need to extract all the date/time/name stamps to total their occurrences. +EDIT+ I need to get the name and date portion from each stamp so that i am able to chart the information in a pivot table. Output of something like; "3/3/2016 Rachel Boyers; 3/2/2016 Rachel Boyers; 3/2/2016 James Dorty"
EX:
"3/3/2016 9:28:36 AM Rachel Boyers: EEHAW! Terri replied!!! Hello Rachel,
I cannot find a match using the 4232A or the 12319 part number. 3/2/2016 7:39:06 AM Rachel Boyers: Sent EM to Terri - Eng per EM reply. 3/2/2016 7:35:06 AM James Dorty: 2/29/16 sent another EM to Kim. Received Auto response as follows: Thank you for your mail. Kim 12/7/2015 12:26:25 PM Frank De La Torre: Again VM - pushing FU out until after the holidays.

Answer 1

Edited based on added information
Edit (5/16/2016): I made some changes to the code, as you'll find below. One change, based on the new information, allows you to use the JoinArrayWithSemiColons function as either a standard worksheet function, or as function to be used in a module. So, what does this mean? It means that (assuming your cell to parse is A1), in cell B1 you can write a function like =JoinArrayWithSemiColons(A1) just like you'd write a normal worksheet function. However, if you'd still like to perform the action over a range of cells using VBA, you can run a procedure like TestFunction() as found in the code posted below. Also note, the ExtractDateTimeUsers function doesn't necessarily ever need to be called directly by the user because it's now being used exclusively as a helper function for the JoinArray... function.
Let me know if this helps to clear things up a bit.
Old Post
You can accomplish this using some Regular Expressions. See the code below for an example. In my case, I have a function to return a multidimensional array of results. In my test procedure, I call this function, then assign the results to an EMPTY matrix of cells (in your test case, you will have to determine where to put it). You do NOT have to assign the result to a group of cells, but rather you can do whatever you want with the array.
Private Function ExtractDateTimeUsers(nInput As String) As Variant()
Dim oReg As Object
Dim aOutput() As Variant
Dim nMatchCount As Integer
Dim i As Integer
Dim vMatches As Object
Set oReg = CreateObject("VBScript.RegExp")
With oReg
.MultiLine = False
.Global = True
.Pattern = "([0-9]{1,2}/[0-9]{1,2}/[0-9]{2,4}) ([0-9]{1,2}:[0-9]{1,2}:[0-9]{1,2} [AP]M) (.*?):"
End With
If oReg.Test(nInput) Then
Set vMatches = oReg.Execute(nInput)
nMatchCount = vMatches.Count
ReDim aOutput(0 To nMatchCount - 1, 0 To 2)
For i = 0 To nMatchCount - 1
aOutput(i, 0) = vMatches(i).Submatches(0)
aOutput(i, 1) = vMatches(i).Submatches(1)
aOutput(i, 2) = vMatches(i).Submatches(2)
Next i
Else
ReDim aOutput(0 To 0, 0 To 0)
aOutput(0, 0) = "No Matches"
End If
ExtractDateTimeUsers = aOutput
End Function
Function JoinArrayWithSemiColons(sInput As String) As String
Dim vArr As Variant
vArr = ExtractDateTimeUsers(sInput)
If vArr(0, 0) = "No Matches" Then
JoinArrayWithSemiColons = "No Matches"
Exit Function
End If
'Loop through array to build the output string
For i = LBound(vArr, 1) To UBound(vArr, 1)
sOutput = sOutput & "; " & vArr(i, 0) & " " & vArr(i, 2)
Next i
JoinArrayWithSemiColons = Mid(sOutput, 3)
End Function
Sub TestFunction()
'Assume the string we are parsing is in Column A
'(I defined a fixed range, but you can make it dynamic as you need)
Dim rngToJoin As Range
Dim rIterator As Range
Set rngToJoin = Range("A10:A11")
For Each rIterator In rngToJoin
rIterator.Offset(, 1).Value = JoinArrayWithSemiColons(rIterator.Value)
Next rIterator
End Sub

Answer 2

As simple (non-regex) function you can use something like this:
Public Function getCounts(str As String) As Variant
Dim output() As Variant, holder As Variant, i As Long
ReDim output(0, 0)
holder = Split(str, " ")
For i = 0 To UBound(holder) - 2
If IsDate(holder(i) & " " & holder(i + 1) & " " & holder(i + 2)) Then
If UBound(output) Then
ReDim Preserve output(1 To 3, 1 To UBound(output, 2) + 1)
Else
ReDim output(1 To 3, 1 To 1)
End If
output(1, UBound(output, 2)) = holder(i)
output(2, UBound(output, 2)) = holder(i + 1) & " " & holder(i + 2)
i = i + 3
While Right(holder(i), 1) <> ":" And i < UBound(holder)
output(3, UBound(output, 2)) = output(3, UBound(output, 2)) & " " & holder(i)
i = i + 1
Wend
output(3, UBound(output, 2)) = Trim(output(3, UBound(output, 2))) & " " & Left(holder(i), Len(holder(i)) - 1)
End If
Next
If Application.Caller.Rows.Count > UBound(output, 2) Then
i = UBound(output, 2)
ReDim Preserve output(1 To 3, 1 To Application.Caller.Rows.Count)
For i = i + 1 To UBound(output, 2)
output(1, i) = ""
output(2, i) = ""
output(3, i) = ""
Next
End If
getCounts = Application.Transpose(output)
End Function
Just put it in a module to use it as UDF. (Outputs a 3-column-table)
If you have any questions, just ask :)

Answer 3

Just another way to do it. Maybe a little slower, but short and easy to read...
Public Function DateCount(str As String) As Variant
Dim pos As Integer, endpos As Integer, namepos As Integer
Dim Text As String, Output() As String, counter As Integer
pos = InStr(pos + 1, str, "/")
Do While pos > 0
endpos = InStr(pos + 1, str, "M ")
Text = Mid(str, pos - 1, endpos - pos + 2)
If IsDate(Text) Then
counter = counter + 1
ReDim Preserve Output(1 To 2, 1 To counter)
namepos = InStr(endpos, str, ":")
Output(1, counter) = Text
Output(2, counter) = Mid(str, endpos + 2, namepos - endpos - 2)
pos = namepos
End If
pos = InStr(pos + 1, str, "/")
Loop
' Only Count
getCounts = counter
' complete List
getCounts = Output
End Function