Macro Help - Remove Excess Data in Cell and Convert Remaining Data to Date Format M/DD/YYYY

[hpageau]

I am looking to remove all this excess tracking data in column D and convert the date within it to the same format as Order Date column C.
I am adding this code to an existing MACRO, so would appreciate any help.

Thank you!

Order	Status	Order date	Ship Date
35339​	processing	1/10/2024 11:41​
35338​	on-hold	1/10/2024 8:43​
35337​	completed	1/9/2024 22:20​	tracking_provider:fedex|tracking_number:789122473074|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122473074;
35336​	completed	1/9/2024 19:22​	tracking_provider:fedex|tracking_number:789122431354|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122431354;
35335​	completed	1/9/2024 18:49​	tracking_provider:fedex|tracking_number:789122422224|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122422224;
35334​	completed	1/9/2024 17:49​	tracking_provider:|custom_tracking_provider:USPS GROUND ADVANTAGE|custom_tracking_link:|tracking_number:9400136106051109001755|date_shipped:2024-01-10|tracking_id:e43aab7a5d5ddb38a4bb1609237cdcbf|formatted_tracking_provider:USPS GROUND ADVANTAGE|formatted_tracking_link:;
35334​	completed	1/9/2024 17:49​	tracking_provider:|custom_tracking_provider:USPS GROUND ADVANTAGE|custom_tracking_link:|tracking_number:9400136106051109001755|date_shipped:2024-01-10|tracking_id:e43aab7a5d5ddb38a4bb1609237cdcbf|formatted_tracking_provider:USPS GROUND ADVANTAGE|formatted_tracking_link:;
35333​	completed	1/9/2024 16:15​	tracking_provider:fedex|tracking_number:789122415760|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122415760;
35332​	completed	1/9/2024 15:31​	tracking_provider:fedex|tracking_number:789122402200|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122402200;
35331​	completed	1/9/2024 12:52​	tracking_provider:fedex|tracking_number:789122388144|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122388144;
35330​	completed	1/9/2024 11:20​	tracking_provider:fedex|tracking_number:789122378636|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122378636;
35329​	completed	1/9/2024 10:37​	tracking_provider:fedex|tracking_number:789122368690|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122368690;
35329​	completed	1/9/2024 10:37​	tracking_provider:fedex|tracking_number:789122368690|date_shipped:2024-01-10|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789122368690;
35328​	completed	1/9/2024 8:48​	tracking_provider:fedex|tracking_number:789071901534|date_shipped:2024-01-09|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789071901534;
35327​	completed	1/9/2024 1:22​	tracking_provider:fedex|tracking_number:789071881366|date_shipped:2024-01-09|formatted_tracking_provider:Fedex|formatted_tracking_link:https://www.fedex.com/apps/fedextrack/?action=track&action=track&tracknumbers=789071881366;

 

[rlv01]

Possibly something like this.

    Dim WS As Worksheet
    Dim rng As Range, R As Range
    Dim S As String
    Dim SPos As Long
    Dim ShipDt As Date
    
    Set WS = ActiveSheet
    
    With WS
        Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        rng.Offset(0, 3).Hyperlinks.Delete
    End With
    
    For Each R In rng
        With R.Offset(0, 3)
            SPos = InStr(.Value, "|date_shipped:")
            If SPos > 0 Then
                S = Replace(Mid(.Value, SPos + 1, Len(.Value)), "|", ":")
                ShipDt = DateValue(Split(S, ":")(1))
                .Value = ShipDt
                .NumberFormat = "mm/dd/yyyy"
            Else
                .Value = "- none - "
            End If
        End With
    Next R

 

[hpageau]

I only had to remove the below and it ended up working FLAWLESSLY! THANK YOU THANK YOU THANK YOU!!!!

Else
.Value = "- none - "

 

[rlv01]

Glad to hear it worked for you.

 

[alansidman]

An alternative means is with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Extracted Text Between Delimiters" = Table.TransformColumns(Source, {{"Ship Date", each Text.BetweenDelimiters(_, "shipped:", "|"), type text}}),
    #"Changed Type" = Table.TransformColumnTypes(#"Extracted Text Between Delimiters",{{"Ship Date", type date}})
in
    #"Changed Type"

Book7
	A	B	C	D
1	Order	Status	Order date	Ship Date
2	35339	processing	1/10/2024 11:41
3	35338	on-hold	1/10/2024 8:43
4	35337	completed	1/9/2024 22:20	1/10/2024
5	35336	completed	1/9/2024 19:22	1/10/2024
6	35335	completed	1/9/2024 18:49	1/10/2024
7	35334	completed	1/9/2024 17:49	1/10/2024
8	35334	completed	1/9/2024 17:49	1/10/2024
9	35333	completed	1/9/2024 16:15	1/10/2024
10	35332	completed	1/9/2024 15:31	1/10/2024
11	35331	completed	1/9/2024 12:52	1/10/2024
12	35330	completed	1/9/2024 11:20	1/10/2024
13	35329	completed	1/9/2024 10:37	1/10/2024
14	35329	completed	1/9/2024 10:37	1/10/2024
15	35328	completed	1/9/2024 8:48	1/9/2024
16	35327	completed	1/9/2024 1:22	1/9/2024
Table1

 

[Rick Rothstein]

Here is a fairly compact VBA method that will work for the data you posted...

Sub GetDate()
  With Columns("D")
    .Replace "*date_shipped:", "", xlPart
    .Replace "|*", "", xlPart
    .Value = .Value
  End With
End Sub