extract a text after searching for a specific name

[swofm]

Hello everyone,
I have this excel spreadsheet and one of the column contains notes. I want to be able to extract a specific text based on a common user.

Below is an example of what is on the notes column. These are all on one cell.

Test,Name1 10/18/2017 8:43:15 AM > FAXED
Test,Name2 11/1/2017 1:49:30 PM > this is for testing purposes only.
Test,Name1 2/20/2018 12:40:30 PM > this is for more testing.
Test,Name1 2/26/2018 10:26:51 AM > testing attached

Say if i want to extract the following: "Test,Name1 10/18/2017", "Test,Name1 2/20/2018", "Test,Name1 2/26/2018" from the notes, I need help on making the formula to extract them and save them on a new sheet. Any help is very much appreciated.

Thank you,
Jason

 

[Roderick_E]

my file has multiple patients (4,185 rows). patientid on column A and patientname on column B, the notes are on column P. so i tried to run it, it created a new sheet but it was blank. Thank you

LOL... now that I have more information how your sheet is structured, I can create the full code. One moment.

 

[Roderick_E]

Also, shouldn't we be searching the patientID rather than name? I suspect the id is unique whereas the name may not be.

 

[Roderick_E]

Actually since the patientID is in column A, apparently a unique one on each row, wouldn't the column P notes only pertain to that patient per row??? We merely need to grab the notes for the selected patient?

 

[swofm]

sorry if i did not paint the whole picture. so this worksheet is a referral report where it can have multiple rows of the same patient but different notes based on the date of the referral. So a patient can have multiple referrals of the same day to different specialists and each will be listed per row. So i'm trying to grab the notes done by a specific user. the problem as i stated earlier, column P is a one big text field where the users just put in their notes by date until they are able to close that referral.

 

[Roderick_E]

sorry if i did not paint the whole picture. so this worksheet is a referral report where it can have multiple rows of the same patient but different notes based on the date of the referral. So a patient can have multiple referrals of the same day to different specialists and each will be listed per row. So i'm trying to grab the notes done by a specific user. the problem as i stated earlier, column P is a one big text field where the users just put in their notes by date until they are able to close that referral.

Ok so we're not looking for the patientid or patientname, first, we're looking up the name of the person who did the referral? Correct?

 

[swofm]

you are on the right track. each row contains the patient id, patientname, notes. say person1 and person2 has notes on that one row alone and i want to see only notes done by person1, my end goal is to be able to do a count on how many times person1 touched the referral grouped by date. that's why i want to extract the name until the date, separate them then convert that date as a date field. hope i explained it well.

patientid	patientname	notes
321	Patient Test	Person1 10/18/2017 8:43:15 AM > FAXED Person2 11/1/2017 1:49:30 PM > I called the office of Dr. Test and asked about Patient Test referral. Person1 2/20/2018 12:40:30 PM > I faxed request for ov notes to the office of Dr. Test. Person1 2/26/2018 10:26:51 AM > notes attached
NEW SHEET WILL LOOK LIKE THIS: <tbody> </tbody>
patientid	patientname	notes
321	Patient Test	Person1 10/18/2017 8:43:15 AM >
321	Patient Test	Person1 2/20/2018 12:40:30 PM >
321	Patient Test	Person1 2/26/2018 10:26:51 AM >

<tbody>
</tbody>

 

[Roderick_E]

Ok try this out.

Option Compare Text 'ignore text case
Sub getrefname()
Dim strarray As String
Dim strunbound() As String
Dim i As Long
Dim cnt As Long
Dim newsheetname As String
Dim refname As String
Dim ssheet As String
Dim lastrow As Long
Dim pidstr As String
Dim pname As String
ssheet = ActiveSheet.Name
lastrow = Worksheets(ssheet).Range("P" & Rows.Count).End(xlUp).Row 'will find lastrow even in hidden columns
refname = InputBox("Input referer name to search")
If Trim(refname) = "" Then
Exit Sub
End If
cnt = 2
newsheetname = Application.Text(Now(), "YYMMDDHHmmss")
With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = newsheetname
    End With
'add headers
ActiveSheet.Range("A1") = "PatientID"
ActiveSheet.Range("B1") = "PatientName"
ActiveSheet.Range("C1") = "Notes"
For x = 1 To lastrow
If Trim(Sheets(ssheet).Cells(x, "P")) <> "" Then ' if notes column not blank
strarray = Sheets(ssheet).Cells(x, "P") 'or any string with unique dilimiter
strunbound = Split(strarray, Chr(10)) 'replace vbCrLf with any unique delimiter such as ","
For i = LBound(strunbound) To UBound(strunbound)
If InStr(strunbound(i), ">") > 0 Then
stringpart = Trim(Left(strunbound(i), InStr(strunbound(i), ">") - 1))
If stringpart Like "*" & refname & "*" Then
Sheets(newsheetname).Cells(cnt, 1) = Sheets(ssheet).Cells(x, "A")
Sheets(newsheetname).Cells(cnt, 2) = Sheets(ssheet).Cells(x, "B")
Sheets(newsheetname).Cells(cnt, 3) = stringpart
cnt = cnt + 1
End If
End If
Next i
End If
Next x
MsgBox "See new tab for results: " & newsheetname
Sheets(newsheetname).Activate
End Sub

 

[swofm]

hats off to you. you're a miracle worker. it works like a charm. as always thank you for the help and sorry i should have been more clearer the first time. the only thing left is to extract the date from that notes string.

 

[Roderick_E]

Glad I could help... and as a gift, here's the code that get the date

Option Compare Text 'ignore text case
Sub getrefname()
Dim strarray As String
Dim strunbound() As String
Dim i As Long
Dim cnt As Long
Dim newsheetname As String
Dim refname As String
Dim ssheet As String
Dim lastrow As Long
Dim pidstr As String
Dim pname As String
ssheet = ActiveSheet.Name
lastrow = Worksheets(ssheet).Range("P" & Rows.Count).End(xlUp).Row 'will find lastrow even in hidden columns
refname = InputBox("Input referer name to search")
If Trim(refname) = "" Then
Exit Sub
End If
cnt = 2
newsheetname = Application.Text(Now(), "YYMMDDHHmmss")
With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = newsheetname
    End With
'add headers
ActiveSheet.Range("A1") = "PatientID"
ActiveSheet.Range("B1") = "PatientName"
ActiveSheet.Range("C1") = "Notes"
[COLOR=#ff0000]ActiveSheet.Range("D1") = "Date"[/COLOR]
For x = 1 To lastrow
If Trim(Sheets(ssheet).Cells(x, "P")) <> "" Then ' if notes column not blank
strarray = Sheets(ssheet).Cells(x, "P") 'or any string with unique dilimiter
strunbound = Split(strarray, Chr(10)) 'replace vbCrLf with any unique delimiter such as ","
For i = LBound(strunbound) To UBound(strunbound)
If InStr(strunbound(i), ">") > 0 Then
stringpart = Trim(Left(strunbound(i), InStr(strunbound(i), ">") - 1))
If stringpart Like "*" & refname & "*" Then
Sheets(newsheetname).Cells(cnt, 1) = Sheets(ssheet).Cells(x, "A")
Sheets(newsheetname).Cells(cnt, 2) = Sheets(ssheet).Cells(x, "B")
Sheets(newsheetname).Cells(cnt, 3) = stringpart
[COLOR=#ff0000]Sheets(newsheetname).Cells(cnt, 4) = Format(Mid(stringpart, InStr(stringpart, "/") - 2, 10), "Short Date")[/COLOR]
cnt = cnt + 1
End If
End If
Next i
End If
Next x
MsgBox "See new tab for results: " & newsheetname
Sheets(newsheetname).Activate
End Sub

 

[swofm]

what can i say...i'm speechless thank you and i really learned a lot.