Mixed Date column (More complicated than mm/dd/yyyy to dd/mmm/yyyy ..... !)

[Karly21]

Hi guys,
Long time lurker, and have benefited greatly of your questions/answers. I am at a very basic VBA level, but have managed some nice stuff with resources like in this forum. (Anyway, thanks in advance for the knowledge already shared). This is the actual first time that I am totally lost. So here it goes.

I have one column with SEVERAL date formats, including: (they look as this in the cell)
Aug-10-2018
Aug-20-2018 15:15
07/27/2018 00:00
Sep-17-2018 13:56
Thursday, September 27, 2018 at 12:12

I need the format to be dd/mm/yyyy hh:mm

As you see, there are lots of problems, the lack of standardization on the dates formats being only one of them. I cannot get my head around this at all, and don't know even where to begin. Sorry I don't have any proof of my attempts to solve this, but I literally only got to separating all of these in columns... and then get no idea what do do afterwards! Even if not with VBA, any solutions will be greatly appreciated.

Thanks to you all kind souls!

 

[sandy666]

look at s666-PQ-ReportFEB2020_MR_Exclel help.xlsx
don't open online, just download

 

[sandy666]

correction: don't edit just download

 

[Peter_SSs]

I have assumed that any non-date values like "Cancelled" should not be returned in the results. Post back if you want such values left in the results.
This macro uses the data in column D of 'Original' & writes the results in column E of that sheet. You could write it back over the original data if you want.
Test with a copy of your workbook.

Sub TidyDates()
  Dim RX As Object, M As Object
  Dim a As Variant, b As Variant
  Dim vPats(1 To 3) As String
  Dim i As Long, j As Long
  
  vPats(1) = "([A-Z]{3})([ \-]?)(\d{1,2})([ \-]?)(\d{4})(a?)( \d{1,2}:\d{1,2})?"
  vPats(2) = "([A-Z]{3,9})([ \-]?)(\d{1,2})(\D{0,2})(\d{4})([ \D]*)(\d{1,2}:\d{1,2})?"
  vPats(3) = "(\d{1,2})([ \-]?)([A-Z]{3,9})([ \-]?)(\d{4})([ \D]*)(\d{1,2}:\d{1,2})?"
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.IgnoreCase = True
  With Sheets("Original")
    a = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value2
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If Not IsNumeric(a(i, 1)) Then
        For j = 1 To UBound(vPats)
          RX.Pattern = vPats(j)
          If RX.Test(a(i, 1)) Then
            Set M = RX.Execute(a(i, 1))
            With M.Item(0)
              b(i, 1) = DateValue(.SubMatches(2) & " " & .SubMatches(0) & " " & .SubMatches(4))
              If Not IsEmpty(.SubMatches(6)) Then b(i, 1) = b(i, 1) + TimeValue(.SubMatches(6))
            End With
            Exit For
          End If
        Next j
      End If
    Next i
    With .Range("E2").Resize(UBound(b))
      .NumberFormat = "dd/mm/yyyy hh:mm"
      .Value = b
    End With
  End With
End Sub

 

[Bobjg]

Can you show me how/where you added the =DATEVALUE () function?

 

[Peter_SSs]

Can you show me how/where you added the =DATEVALUE () function?

Always best to identify who you are addressing when multiple posters are involved in a thread.
I'm not really sure what you are asking if the question was for me? DateValue is a standard built-in vba function.

 

[Karly21]

I have assumed that any non-date values like "Cancelled" should not be returned in the results. Post back if you want such values left in the results.
This macro uses the data in column D of 'Original' & writes the results in column E of that sheet. You could write it back over the original data if you want.
Test with a copy of your workbook.

Sub TidyDates()
  Dim RX As Object, M As Object
  Dim a As Variant, b As Variant
  Dim vPats(1 To 3) As String
  Dim i As Long, j As Long
 
  vPats(1) = "([A-Z]{3})([ \-]?)(\d{1,2})([ \-]?)(\d{4})(a?)( \d{1,2}:\d{1,2})?"
  vPats(2) = "([A-Z]{3,9})([ \-]?)(\d{1,2})(\D{0,2})(\d{4})([ \D]*)(\d{1,2}:\d{1,2})?"
  vPats(3) = "(\d{1,2})([ \-]?)([A-Z]{3,9})([ \-]?)(\d{4})([ \D]*)(\d{1,2}:\d{1,2})?"
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.IgnoreCase = True
  With Sheets("Original")
    a = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value2
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If Not IsNumeric(a(i, 1)) Then
        For j = 1 To UBound(vPats)
          RX.Pattern = vPats(j)
          If RX.Test(a(i, 1)) Then
            Set M = RX.Execute(a(i, 1))
            With M.Item(0)
              b(i, 1) = DateValue(.SubMatches(2) & " " & .SubMatches(0) & " " & .SubMatches(4))
              If Not IsEmpty(.SubMatches(6)) Then b(i, 1) = b(i, 1) + TimeValue(.SubMatches(6))
            End With
            Exit For
          End If
        Next j
      End If
    Next i
    With .Range("E2").Resize(UBound(b))
      .NumberFormat = "dd/mm/yyyy hh:mm"
      .Value = b
    End With
  End With
End Sub

Hi all, this works like a dream, thank you so much!
-- Sorry I had not gone in, some other stuff took over my whole attention and have not even been in the forum. I haven't even been able to study - but this solved the problem and gives me a lot to learn from THANK YOU VERY MUCH

 

[Karly21]

I have assumed that any non-date values like "Cancelled" should not be returned in the results. Post back if you want such values left in the results.
This macro uses the data in column D of 'Original' & writes the results in column E of that sheet. You could write it back over the original data if you want.
Test with a copy of your workbook.

Sub TidyDates()
  Dim RX As Object, M As Object
  Dim a As Variant, b As Variant
  Dim vPats(1 To 3) As String
  Dim i As Long, j As Long
 
  vPats(1) = "([A-Z]{3})([ \-]?)(\d{1,2})([ \-]?)(\d{4})(a?)( \d{1,2}:\d{1,2})?"
  vPats(2) = "([A-Z]{3,9})([ \-]?)(\d{1,2})(\D{0,2})(\d{4})([ \D]*)(\d{1,2}:\d{1,2})?"
  vPats(3) = "(\d{1,2})([ \-]?)([A-Z]{3,9})([ \-]?)(\d{4})([ \D]*)(\d{1,2}:\d{1,2})?"
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.IgnoreCase = True
  With Sheets("Original")
    a = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value2
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If Not IsNumeric(a(i, 1)) Then
        For j = 1 To UBound(vPats)
          RX.Pattern = vPats(j)
          If RX.Test(a(i, 1)) Then
            Set M = RX.Execute(a(i, 1))
            With M.Item(0)
              b(i, 1) = DateValue(.SubMatches(2) & " " & .SubMatches(0) & " " & .SubMatches(4))
              If Not IsEmpty(.SubMatches(6)) Then b(i, 1) = b(i, 1) + TimeValue(.SubMatches(6))
            End With
            Exit For
          End If
        Next j
      End If
    Next i
    With .Range("E2").Resize(UBound(b))
      .NumberFormat = "dd/mm/yyyy hh:mm"
      .Value = b
    End With
  End With
End Sub

I Thanked this in a different thread... how am I supposed to address people directly?

Anywya, thanks again so much for this - is going to save me hours of work - time where I can keep on learning VBA!!!!!!

 

[mole999]

I Thanked this in a different thread... how am I supposed to address people directly?

you can use the ampersand @Karly21

 

[sandy666]

ampersand & ?
rather At sign: @

 

[Peter_SSs]

Hi all, this works like a dream, thank you so much!
-- Sorry I had not gone in, some other stuff took over my whole attention and have not even been in the forum. I haven't even been able to study - but this solved the problem and gives me a lot to learn from THANK YOU VERY MUCH

You are very welcome. Thanks for the follow-up.

I Thanked this in a different thread... how am I supposed to address people directly?

Apart from the way mole999 has suggested, you can always do it the way you did in posts 16 & 17 by 'quoting' something that person has said, just as I have done here too.

As it happens, my comment about addressing people directly was not directed at you but to Bobjg, as you can see by my quote of theirs immediately above my comment in post 15.