Possible to pull apart 1st section of string for date & time

[Bond00]

So people type notes in short hand, and I'd like to be able to have a button linked to vba to auto pull apart the first date and time part of the text and put them into the proper cells shown below.
So this list in Col D will go down to an unknown row # so maybe use LRow = ws2.Range("B138").End(xlUp).Row to get the bottom row to work with. (this is in worksheet2)
Example:

Book1
	A	B	C	D	E	F	G	H	I
1	ID	Cus	Ticket	Description	Date	Start Time	AM/PM	End Time	AM/PM
2				10/8 2-530pm Work on system checks, fixed any errors found	8-Oct	2:00	PM	5:30	PM
3				10/9 11am-230pm Work on system repairs and firmware upgrades	9-Oct	11:00	AM	2:30	PM
4				10/9 230-5pm Work on reviews	9-Oct	2:30	PM	5:00	PM
5				10/10 930-1130am Worked on installing local program accounts and called service to get software downloads, after install setup attached its database to main server.	10-Oct	9:30	AM	11:30	AM
6				10/10 1130-3pm Review all system projects and collect data	10-Oct	11:30	AM	3:00	PM
Sheet1

So if they type 10/8 2-530pm put the date into col E and start time being 2pm into col F and PM into col G and 530 into col H and PM into col I
Now it can be assumed (almost always) that if the first # doesn't have a AM or PM with it that its the same as the 2nd # in this case above its 2-530pm so 2 is also PM by assumption.

There is occasional times when its like 10/10 1130-3pm and the 11:30 is assumed AM in this case since they didn't work from 1130pm yesterday until 3pm today. So maybe a rule that if the math is over 12 hrs then assume the correct time from that. in this case assume its AM since if it was 11:30PM-3PM it would be over 12 hrs span.
If this rule is ever broken for some reason then its fine we just correct it manually since it will almost never happen.

Also when the button is pressed and the date and time is put into the proper cells remove the first part and place the rest of the text back into col D (without the date and time in front)

thanks for taking a look at this!

 

[Bond00]

Needs clarification. The code outputs 6 columns & that obviously cannot all fit into column K. Do you mean send the out to start at col K, thereby filling cols K:O or do you mean something else?


Definitely not. That would require a different code. How much different might depend on the answer to the first question above.
Would any additional data always just be added at the bottom or could you end up with lines that do not start with a digit and then lines that do and more lines that don't and then more lines that do etc?

your Date_Time_v4 code also gives that # output along with the times now, so was wondering if that can go to col K like it was before instead of col H like in your example.

Also any additional data would always go at the bottom. so it would be added to so you wouldnt need to worry about anything mixed in the middle. You could probably do a scan of the rows starting at D16 finding the first row in D col that has a # and then make that the range or something?

 

[Peter_SSs]

You could probably do a scan of the rows starting at D16

OK, so I am assuming headers in row 15 - see 'Const' line in the code

Try this with a copy of your data

Sub Date_Time_v5()
  Dim a As Variant, b As Variant, Bits As Variant, t As Variant
  Dim i As Long
  Dim ampm1 As String, ampm2 As String
  
  Const HdrRow As Long = 15 '<- Header row
  
  a = Range("D" & HdrRow + 1, Range("D" & Rows.Count).End(xlUp).Offset(1)).Value
  i = 1
  Do Until IsNumeric(Left(a(i, 1), 1)) Or i = UBound(a)
    i = i + 1
  Loop
  If i < UBound(a) Then
    With Range("D" & HdrRow + i, Range("D" & Rows.Count).End(xlUp).Offset(1))
      a = .Value
      ReDim b(1 To UBound(a), 1 To 5)
      For i = 1 To UBound(a) - 1
        Bits = Split(Replace(Replace(a(i, 1), "-", " "), "/", " "), , 5)
        ampm1 = ""
        b(i, 1) = Bits(4)
        b(i, 2) = DateSerial(Year(Date), Bits(0), Bits(1))
        ampm2 = UCase(Right(Bits(3), 2))
        t = Replace(Bits(3), ampm2, "", , , 1)
        b(i, 4) = TimeValue(IIf(Len(t) < 3, t, Format(t, "00:00")) & ampm2)
        If UCase(Right(Bits(2), 1)) = "M" Then ampm1 = UCase(Right(Bits(2), 2))
        t = Replace(Bits(2), ampm1, "", , , 1)
        b(i, 3) = TimeValue(IIf(Len(t) < 3, t, Format(t, "00:00")) & IIf(ampm1 = "", ampm2, ampm1))
        If b(i, 3) > b(i, 4) And ampm1 = "" Then b(i, 3) = b(i, 3) + IIf(ampm2 = "AM", 0.5, -0.5)
        b(i, 5) = 24 * IIf(b(i, 3) > b(i, 4), b(i, 3) - b(i, 4), b(i, 4) - b(i, 3))
        If b(i, 5) > 12 Then b(i, 5) = 24 - b(i, 5)
      Next i
      With .Resize(, 4)
        .Value = b
        .Columns(2).NumberFormat = "d-mmm"
        .Columns(3).Resize(, 2).NumberFormat = "h:mm AM/PM"
        .Columns(8).Value = Application.Index(b, 0, 5)
        .Columns(8).NumberFormat = "0.00"
      End With
    End With
  End If
End Sub

 

[Bond00]

OK, so I am assuming headers in row 15 - see 'Const' line in the code

Try this with a copy of your data

Sub Date_Time_v5()
  Dim a As Variant, b As Variant, Bits As Variant, t As Variant
  Dim i As Long
  Dim ampm1 As String, ampm2 As String
 
  Const HdrRow As Long = 15 '<- Header row
 
  a = Range("D" & HdrRow + 1, Range("D" & Rows.Count).End(xlUp).Offset(1)).Value
  i = 1
  Do Until IsNumeric(Left(a(i, 1), 1)) Or i = UBound(a)
    i = i + 1
  Loop
  If i < UBound(a) Then
    With Range("D" & HdrRow + i, Range("D" & Rows.Count).End(xlUp).Offset(1))
      a = .Value
      ReDim b(1 To UBound(a), 1 To 5)
      For i = 1 To UBound(a) - 1
        Bits = Split(Replace(Replace(a(i, 1), "-", " "), "/", " "), , 5)
        ampm1 = ""
        b(i, 1) = Bits(4)
        b(i, 2) = DateSerial(Year(Date), Bits(0), Bits(1))
        ampm2 = UCase(Right(Bits(3), 2))
        t = Replace(Bits(3), ampm2, "", , , 1)
        b(i, 4) = TimeValue(IIf(Len(t) < 3, t, Format(t, "00:00")) & ampm2)
        If UCase(Right(Bits(2), 1)) = "M" Then ampm1 = UCase(Right(Bits(2), 2))
        t = Replace(Bits(2), ampm1, "", , , 1)
        b(i, 3) = TimeValue(IIf(Len(t) < 3, t, Format(t, "00:00")) & IIf(ampm1 = "", ampm2, ampm1))
        If b(i, 3) > b(i, 4) And ampm1 = "" Then b(i, 3) = b(i, 3) + IIf(ampm2 = "AM", 0.5, -0.5)
        b(i, 5) = 24 * IIf(b(i, 3) > b(i, 4), b(i, 3) - b(i, 4), b(i, 4) - b(i, 3))
        If b(i, 5) > 12 Then b(i, 5) = 24 - b(i, 5)
      Next i
      With .Resize(, 4)
        .Value = b
        .Columns(2).NumberFormat = "d-mmm"
        .Columns(3).Resize(, 2).NumberFormat = "h:mm AM/PM"
        .Columns(8).Value = Application.Index(b, 0, 5)
        .Columns(8).NumberFormat = "0.00"
      End With
    End With
  End If
End Sub

sorry wasn't able to test it for a few days there. but yeah thats perfect, everything works great now. Thanks a lot for all the help with this!

and yes headers on row 15, but whats that affect? just for knowing the starting row # is 16?

 

[Peter_SSs]

Thanks a lot for all the help with this!

You are welcome. Glad we seem to have got there in the end.

and yes headers on row 15, but whats that affect? just for knowing the starting row # is 16?

No significant difference really, it is just that my thinking (& code) were based on what happens below the header row rather than what happens on the first row and below.
Also, in the forum when you are told what the first row is, sometimes it turns out to be the row that the headers are on and sometimes it turns out to be the first row of data below the headers. I was just clarifying that as well.