Trying (unsuccessfully) to pull a date from the middle of a string

[zookeepertx]

Hello all,

I have spent 2 days trying to get this to work right and I'm obviously leaving out a parenthesis or a comma or something.

So, I'm trying with VBA to extract just the date from the following text:

Date created: 9/24/2024 2:35:55 PM

I don't want the spaces before or after the date and whether the month and day are 1 or 2 characters, it needs to show the whole date. (I don't want a formula in the report, I just want the date to appear in F2 (or whatever row is the current destination row).
My thinking was to use MID. Establish the cell being evaluated, find the first character after the : - which would be 9 in this case - to use as the start character. Then - to find the length of the result I need - find the first space after the: and subtract it from the length of text in the cell.

Here's what I've arrived at at this point but it's not working:

Mid(Cells(i, 1), (InStr(Cells(i, 1), ":") +2), (Len(Cells(i, 1) ) -((InStr(Cells(i,1), " " ) , (InStr(Cells(i, 1), ":") +2)-1) )))

But I keep getting a "Compile error: Expected )" message.

Can someone enlighten me as to what I'm leaving out or have in there that I don't need?

I would be very grateful; I'm so tired of looking at this I could tear my hair out!

Jenny

 

[Scott Huish]

Scott,

Your formula worked for me, but not the Function. Not sure why, but it seems to choke on the CDATE part of the function.

Weird. It worked in my testing.

 

[zookeepertx]

=INT(TRIM(MID(A1,14,100)))

Function GetDate(r As String)
GetDate = Int(CDate(Trim(Mid(r, 14))))
End Function

Format result cell as Date

Hi Scott,
The first formula, placed where my MID/InStr line was gives me a "Runtime error 13: Type mismatch" on that row of the code.

The Function confuses me a bit. I'm not sure where to put it. (I'm a dunce sometimes)

Here's what I have for the section of code that pulls the data from each of the rows:

For j = 2 To lr Step 31
    For i = j + 1 To j + 13
        If LCase(Cells(i, 1).Value) Like LCase("Order Number:*") Then Cells(r, 2).Value = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)
        If LCase(Cells(i, 1).Value) Like LCase("Page count:*") Then Cells(r, 3).Value = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)
        If LCase(Cells(i, 1).Value) Like LCase("Created by:*") Then Cells(r, 4).Value = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)
        If LCase(Cells(i, 1).Value) Like LCase("Last modified*") Then Cells(r, 5).Value = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)
        If LCase(Cells(i, 1).Value) Like LCase("Date created:*") Then Cells(r, 6).Value = Mid(Cells(i, 1), (InStr(Cells(i, 1), ":") +2), (Len(Cells(i, 1) ) -((InStr(Cells(i,1), " " ) , (InStr(Cells(i, 1), ":") +2)-1) )))
        If LCase(Cells(i, 1).Value) Like LCase("Date modified:*") Then Cells(r, 7).Value = "6"
        If LCase(Cells(i, 1).Value) Like LCase("Last name:*") Then Cells(r, 8).Value = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)
        If LCase(Cells(i, 1).Value) Like LCase("First name:*") Then Cells(r, 9).Value = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)
        If LCase(Cells(i, 1).Value) Like LCase("Store number:*") Then Cells(r, 10).Value = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)
    Next
    r = r + 1
Next j

(The line for "Date modified" just shows a 6 because that was when I was just trying to make sure that SOMETHING was appearing in the cells where I need the results, LOL!)
Here's an example of 2 of the files on my "practice sheet". Following that is the result I need in columns B-J.

YVONNE MCBURNEY

Export - Creation date 9/24/2024 7:35:55 PM - Last modified 9/24/2024 7:36:28 PM - 4 pages - 1.44 MB

Name: YVONNE MCBURNEY

Order Number: 64399172-11

Page count: 4

Created by: Esther_Hernandez

Last modified by: Esther_Hernandez

Date created: 9/24/2024 2:35:55 PM

Date modified: 9/24/2024 2:36:28 PM

Last Name: MCBURNEY

First Name: YVONNE

Store Number: 7010

Shipment Type: Standard

Export - Document Type: CMOS Ticket

PT or Rec Date: 9/24/2024 12:00:00 AM

Paid Date:

Package ID:

Tracking Number: 405564296845

Fields

Export - Document Type:CMOS Ticket

First Name:YVONNE

Last Name:MCBURNEY

Order Number:64399172-11

Package ID:

Paid Date:

PT or Rec Date:9/24/2024

Shipment Type:Standard

Store Number:7010

Tracking Number:405564296845

Show more information...

WALKYRIA SANTOS COLON

Export - Creation date 9/25/2024 7:55:21 PM - Last modified 9/25/2024 7:56:16 PM - 4 pages - 1.66 MB

Name: WALKYRIA SANTOS COLON

Order Number: 64303647-10

Page count: 4

Created by: Esther_Hernandez

Last modified by: Esther_Hernandez

Date created: 10/2/2024 2:55:21 PM

Date modified: 10/2/2024 2:56:16 PM

Last Name: COLON

First Name: WALKYRIA SANTOS

Store Number: 7010

Shipment Type: Standard

Export - Document Type:

PT or Rec Date: 9/25/2024 12:00:00 AM

Paid Date:

Package ID:

Tracking Number: 704928362535

Order	Pgs	Created by	Modified by	Creation date	Modified date	Last name	First name	Store
64399172-11	4	Esther_Hernandez	Esther_Hernandez	9/24/2024	9/24/2024	MCBURNEY	YVONNE	7010
64303647-10	4	Esther_Hernandez	Esther_Hernandez	10/2/2024	10/2/2024	COLON	WALKYRIA SANTOS	7010

Jenny

 

[zookeepertx]

If you are going to have to do this a number of times and want to use VBA, we can actually build our own User Defined Function (UDF) to do it, like this:

Function GetDate(str As String) As String

    Dim arr1() As String
    Dim arr2() As String
   
'   Copy off beginning of string
    arr1 = Split(str, ": ")
'   Chop off end of string
    arr2 = Split(arr1(1), " ")
   
'   Return date portion of string
    GetDate = arr2(0)
   
End Function

Then, you can call it from anywhere in your VBA procedures or as function on your Excel sheet, i.e.

Sub MyTest()
    MsgBox GetDate(Range("A1").Value)
End Sub

I'm embarrassed to say that this example and the one you put above it - I don't know where to put them in my code to make them work. I'm over-thinking it and then I can't think at all. (ADHD)

I put more info as to what I'm working with in a reply to Scott, so you might take a look at that.

 

[Joe4]

I'm embarrassed to say that this example and the one you put above it - I don't know where to put them in my code to make them work. I'm over-thinking it and then I can't think at all. (ADHD)

I put more info as to what I'm working with in a reply to Scott, so you might take a look at that.

Just put it in a General VBA Module - you can actually put right below your current sub procedure.

 

[RoryA]

Perhaps just:

If LCase(Cells(i, 1).Value) Like LCase("Date modified:*") Then Cells(r, 7).Value = Split(Application.Trim(Cells(i, 1)), " ")(2)

 

[Fuji]

Perhaps like this.

Sub test()
    Dim a, i&, ii&, n&, x, myList
    myList = Array("Order Number", "Page count", "Created by", "Last modified by", _
            "Date created", "Date modified", "Last name", "First name", "Store number")
    With Range("a1", Range("a" & Rows.Count).End(xlUp))
        a = .Value2
        ReDim b(1 To UBound(a, 1), 1 To UBound(myList) + 1)
    End With
    For i = 1 To UBound(a, 1)
        If a(i, 1) = UCase$(a(i, 1)) Then n = n + 1
        For ii = 0 To UBound(myList)
            If UCase$(a(i, 1)) Like UCase$(myList(ii) & ":*") Then Exit For
        Next
        If ii < UBound(myList) + 1 Then
            If b(n, ii + 1) = "" Then b(n, ii + 1) = Split(a(i, 1), ": ")(1)
            If myList(ii) Like "Date*" Then
                x = Split(Split(Split(a(i, 1), ": ")(1))(0), "/")
                If UBound(x) = 2 Then b(n, ii + 1) = DateSerial(x(2), x(0), x(1))
            End If
        End If
    Next
    With [b1].Resize(, UBound(b, 2))
        .EntireColumn.ClearContents
        .Value = myList
        .Rows(2).Resize(n) = b
        .EntireColumn.AutoFit
    End With
End Sub

Got

Book1
	A	B	C	D	E	F	G	H	I	J
1	YVONNE MCBURNEY	Order Number	Page count	Created by	Last modified by	Date created	Date modified	Last name	First name	Store number
2	Export - Creation date 9/24/2024 7:35:55 PM - Last modified 9/24/2024 7:36:28 PM - 4 pages - 1.44 MB	64399172-11	4	Esther_Hernandez	Esther_Hernandez	2024/9/24	2024/9/24	MCBURNEY	YVONNE	7010
3	Name: YVONNE MCBURNEY	64303647-10	4	Esther_Hernandez	Esther_Hernandez	2024/10/2	2024/10/2	COLON	WALKYRIA SANTOS	7010
4	Order Number: 64399172-11
5	Page count: 4
6	Created by: Esther_Hernandez
7	Last modified by: Esther_Hernandez
8	Date created: 9/24/2024 2:35:55 PM
9	Date modified: 9/24/2024 2:36:28 PM
10	Last Name: MCBURNEY
11	First Name: YVONNE
12	Store Number: 7010
13	Shipment Type: Standard
14	Export - Document Type: CMOS Ticket
15	PT or Rec Date: 9/24/2024 12:00:00 AM
16	Paid Date:
17	Package ID:
18	Tracking Number: 405564296845
19	Fields
20	Export - Document Type:CMOS Ticket
21	First Name:YVONNE
22	Last Name:MCBURNEY
23	Order Number:64399172-11
24	Package ID:
25	Paid Date:
26	PT or Rec Date:9/24/2024
27	Shipment Type:Standard
28	Store Number:7010
29	Tracking Number:405564296845
30	Show more information...
31	WALKYRIA SANTOS COLON
32	Export - Creation date 9/25/2024 7:55:21 PM - Last modified 9/25/2024 7:56:16 PM - 4 pages - 1.66 MB
33	Name: WALKYRIA SANTOS COLON
34	Order Number: 64303647-10
35	Page count: 4
36	Created by: Esther_Hernandez
37	Last modified by: Esther_Hernandez
38	Date created: 10/2/2024 2:55:21 PM
39	Date modified: 10/2/2024 2:56:16 PM
40	Last Name: COLON
41	First Name: WALKYRIA SANTOS
42	Store Number: 7010
43	Shipment Type: Standard
44	Export - Document Type:
45	PT or Rec Date: 9/25/2024 12:00:00 AM
46	Paid Date:
47	Package ID:
48	Tracking Number: 704928362535
Sheet1

 

[zookeepertx]

Just put it in a General VBA Module - you can actually put right below your current sub procedure.

Well, I just feel really stupid. I can't seem to get this right. I put your code below my existing code and then, up in the line I'm trying to fix, I changed it to:

If LCase(Cells(i, 1).Value) Like LCase("Date created:*") Then Cells(r, 6).Value = GoSub MyTest

Of course, that doesn't work. I have a big problem getting syntax correct; always have. Here is my current version; it fails at the comma between the InStr for the " " and the InStr for the ":" in the last part of the code. (I tried to make the comma stand out by making it red, but can't make it do that.) Anyway, the error when it fails says Compile error; expected )

Mid(Cells(i, 1), (InStr(Cells(i, 1), ":") +2), (Len(Cells(i, 1)) -((InStr(Cells(i,1), " "), (InStr(Cells(i, 1), ":") +2)-1))))

I don't understand what it is about that code that makes it fail. I was SO hoping I had it right and could feel good that I did something by myself. I can make it a formula using Find instead of InStr like the VBA code and that works fine. But when I try to convert it to InStr it just won't work.

 

[zookeepertx]

Perhaps just:

If LCase(Cells(i, 1).Value) Like LCase("Date modified:*") Then Cells(r, 7).Value = Split(Application.Trim(Cells(i, 1)), " ")(2)

Hi Rory,

I tried your code and it wanted to work but it's not quite right. With the (2) at the end, it returns the time - "2:35:55". Just for fun I tried changing the (2) around. When I made it (1) it returns "created: 9/24/2024". When I made it (3) it returns "PM". That doesn't make sense (to me) because if (1) makes it start at the first space - before "created" shouldn't (2) make it start at the second space - before "9/24/2024" and (3) make it start at the third space - before "2:35:55"? And following that train of thought (4) should make it start before "PM". But apparently only in my head, LOL!

Jenny

 

[RoryA]

It seems some of the spaces in the text are not real spaces. Most likely one is a non-breaking space, so try:

If LCase(Cells(i, 1).Value) Like LCase("Date modified:*") Then Cells(r, 7).Value = Split(Application.Trim(Replace$(Cells(i, 1).Value, chr(160), " ")), " ")(2)

 

[zookeepertx]

It seems some of the spaces in the text are not real spaces. Most likely one is a non-breaking space, so try:

If LCase(Cells(i, 1).Value) Like LCase("Date modified:*") Then Cells(r, 7).Value = Split(Application.Trim(Replace$(Cells(i, 1).Value, chr(160), " ")), " ")(2)

That's working perfectly; returns the exact date with no extra spaces before or after! Thank you!!

Today, though, I discovered 2 other "oddities. I don't know if I need to start another thread or put them here so I'm just gonna put them here and hope for the best, LOL!

First off, once in a while apparently there will be a row without data in the row that I'm expecting it. In this case, one of the rows has just "Order Number: " with no actual number there. So, of course, the macro doesn't know what to do with that and failed. But all I had to do was drag the arrow in the coding to the next line and the rest of it completed as normal. Any way to handle that?

Second, I just pulled a new version of the report to test the macro on and this time each file is set up in a group of 26 rows (including a blank row in between files) instead of 32! I had it going down through like this:

For j = 2 To lr Step 32

I changed the 31 in the code to 26 and everything went fine.
But, evidently, it's not hard and fast that there will be a set # of rows in each file. (Because apparently, expecting things to be consistent is just crazy talk! ). On the plus side, every order does seem to end with a row that says "Show more information..." with a blank row below it. Is it possible to set use that as the last row of each file to set the # of rows for the "Step" part of the For loop? Just in case it's going to be changing whenever it feels like. Although, from just the 2 test reports I've pulled it APPEARS that within a single pull of the report, the# of rows grouped for a file are the same in THAT report.

I wish they would just STOP "upgrading" things; it's never done anything but cause more trouble.

Anyway, I'm going to go ahead and mark this Solved since my main problem was actually solved. But if you have any thoughts on the 2 new problems that I just discovered today, it would be greatly appreciated!

Thank you again
Jenny