Can you extract each instance of *##-##-##* in a string?

[HockeyDiablo]

Say you had the following data in "A1";

12-24-16 was Christmas, 03-15-16 was another day 07-13-16 people didn't always use commas; 09-27-16 or whatever type well.

Could you get the data extracted like this?:

[TABLE="class: grid, width: 600, align: center"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD="align: center"]data thats above[/TD]
[TD="align: center"]12-24-16[/TD]
[TD="align: center"]03-15-16[/TD]
[TD="align: center"]07-13-16[/TD]
[TD="align: center"]09-27-16[/TD]
[TD="align: center"]open for more occurrences?[/TD]
[/TR]
</tbody>[/TABLE]

 

[Rick Rothstein]

Assuming your data starts in cell A1, give this macro a try...

Sub ExtractDates()
  Dim R As Long, X As Long, Txt As String, Nums As Variant
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Cells(R, "A").Value
    For X = 1 To Len(Txt) - 8
      If Mid(Txt, X, 1) Like "[!0-9-]" Then Mid(Txt, X) = " "
    Next
    Nums = Split(Application.Trim(Txt))
    For X = 0 To UBound(Nums)
      If Not Nums(X) Like "##-##-##" Then Nums(X) = ""
    Next
    Cells(R, "B").Value = Application.Trim(Join(Nums))
  Next
  Columns("B").TextToColumns , xlDelimited, , , 0, 0, 0, 1
End Sub

 

[HockeyDiablo]

Assuming your data starts in cell A1, give this macro a try...

Sub ExtractDates()
  Dim R As Long, X As Long, Txt As String, Nums As Variant
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Cells(R, "A").Value
    For X = 1 To Len(Txt) - 8
      If Mid(Txt, X, 1) Like "[!0-9-]" Then Mid(Txt, X) = " "
    Next
    Nums = Split(Application.Trim(Txt))
    For X = 0 To UBound(Nums)
      If Not Nums(X) Like "##-##-##" Then Nums(X) = ""
    Next
    Cells(R, "B").Value = Application.Trim(Join(Nums))
  Next
  Columns("B").TextToColumns , xlDelimited, , , 0, 0, 0, 1
End Sub

Simply brilliant,
ty kindly

 

[HockeyDiablo]

Assuming your data starts in cell A1, give this macro a try...

Sub ExtractDates()
  Dim R As Long, X As Long, Txt As String, Nums As Variant
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Cells(R, "A").Value
    For X = 1 To Len(Txt) - 8
      If Mid(Txt, X, 1) Like "[!0-9-]" Then Mid(Txt, X) = " "
    Next
    Nums = Split(Application.Trim(Txt))
    For X = 0 To UBound(Nums)
      If Not Nums(X) Like "##-##-##" Then Nums(X) = ""
    Next
    Cells(R, "B").Value = Application.Trim(Join(Nums))
  Next
  Columns("B").TextToColumns , xlDelimited, , , 0, 0, 0, 1
End Sub

The program worked for all 97k rows, takes about 50 minutes to run. I did notice it didn't catch instances of a one digit month format ex: 6-30-16 The program is looking for ##-##-## not ?#-##-## any work arounds to this?

Thank you

 

[Rick Rothstein]

The program worked for all 97k rows, takes about 50 minutes to run

That sounds kind of long to me... how much text do you have in your cells?

I did notice it didn't catch instances of a one digit month format ex: 6-30-16 The program is looking for ##-##-## not ?#-##-## any work arounds to this?

That is because you said the dates would be ##-##-## which I took to mean leading zeroes would be used to fill out each section to two digits (especially since your examples showed leading zeroes). I can modify the code, but first need to know if the middle section can possibly be a single digit (no leading zero) as well? I assume the year will always be two digits long.

 

[HockeyDiablo]

That sounds kind of long to me... how much text do you have in your cells?



That is because you said the dates would be ##-##-## which I took to mean leading zeroes would be used to fill out each section to two digits (especially since your examples showed leading zeroes). I can modify the code, but first need to know if the middle section can possibly be a single digit (no leading zero) as well? I assume the year will always be two digits long.

I ran a len and found the len to be anywhere from 1-9642

I have not seen an instance of single number "middle section" but I am sure out of the possibilities that it does exist.

 

[Rick Rothstein]

I ran a len and found the len to be anywhere from 1-9642

I have not seen an instance of single number "middle section" but I am sure out of the possibilities that it does exist.

Given the amount of text I think you are indicating you have, I can see why my code may be taking so long to run. I think you might do better with a solution that employs a Regular Expression (RegExp) engine... unfortunately, that is not my "thing". We have a few volunteers here who know how to effectively create RegExp solutions so hopefully one of them will come along and help out. I have modified my code to allow for single digits in either the first or second sections of your dates, but I am afraid that accounting for those extra conditions may slow the code down slightly. Anyway, until someone with RegExp experience comes along, here is [table="width: 500"]
[tr]
[td]my code modified to handle the non-leading-digits possibilities...

Sub ExtractDates()
  Dim R As Long, X As Long, Txt As String, Nums As Variant
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Cells(R, "A").Value
    For X = 1 To Len(Txt) - 8
      If Mid(Txt, X, 1) Like "[!0-9-]" Then Mid(Txt, X) = " "
    Next
    Nums = Split(Application.Trim(Txt))
    For X = 0 To UBound(Nums)
      If Not (Nums(X) Like "##-##-##" Or Nums(X) Like "#-##-##" Or _
              Nums(X) Like "##-#-##" Or Nums(X) Like "#-#-##") Then Nums(X) = ""
    Next
    Cells(R, "B").Value = Application.Trim(Join(Nums))
  Next
  Columns("B").TextToColumns , xlDelimited, , , 0, 0, 0, 1
End Sub[/td]
[/tr]
[/table]

 

[HockeyDiablo]

Given the amount of text I think you are indicating you have, I can see why my code may be taking so long to run. I think you might do better with a solution that employs a Regular Expression (RegExp) engine... unfortunately, that is not my "thing". We have a few volunteers here who know how to effectively create RegExp solutions so hopefully one of them will come along and help out. I have modified my code to allow for single digits in either the first or second sections of your dates, but I am afraid that accounting for those extra conditions may slow the code down slightly. Anyway, until someone with RegExp experience comes along, here is [TABLE="width: 500"]
<tbody>[TR]
[TD]my code modified to handle the non-leading-digits possibilities...

Sub ExtractDates()
  Dim R As Long, X As Long, Txt As String, Nums As Variant
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Cells(R, "A").Value
    For X = 1 To Len(Txt) - 8
      If Mid(Txt, X, 1) Like "[!0-9-]" Then Mid(Txt, X) = " "
    Next
    Nums = Split(Application.Trim(Txt))
    For X = 0 To UBound(Nums)
      If Not (Nums(X) Like "##-##-##" Or Nums(X) Like "#-##-##" Or _
              Nums(X) Like "##-#-##" Or Nums(X) Like "#-#-##") Then Nums(X) = ""
    Next
    Cells(R, "B").Value = Application.Trim(Join(Nums))
  Next
  Columns("B").TextToColumns , xlDelimited, , , 0, 0, 0, 1
End Sub[/TD]
[/TR]
</tbody>[/TABLE]
[CODE]

added 4 more instances with #### on the third series. I tested it and it worked great, then I ran the 97k file and it only took about 7 seconds now! Amazing work.

 

[Rick Rothstein]

added 4 more instances with #### on the third series. I tested it and it worked great, then I ran the 97k file and it only took about 7 seconds now! Amazing work.

I did nothing that would have changed the speed of my original code, so either your 50 minutes was not measured using my original code or something is drastically wrong with the results of my new code.

If you made some of the dates have 4-digit years (what I think you are calling the third series), then my code will not pick them up (because every indication so far has been the year value would be two digits so that is what I designed my code for).

 

[HockeyDiablo]

I did nothing that would have changed the speed of my original code, so either your 50 minutes was not measured using my original code or something is drastically wrong with the results of my new code.

If you made some of the dates have 4-digit years (what I think you are calling the third series), then my code will not pick them up (because every indication so far has been the year value would be two digits so that is what I designed my code for).

Sub ExtractDates()  Dim R As Long, X As Long, Txt As String, Nums As Variant
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Cells(R, "A").Value
    For X = 1 To Len(Txt) - 8
      If Mid(Txt, X, 1) Like "[!0-9-]" Then Mid(Txt, X) = " "
    Next
    Nums = Split(Application.Trim(Txt))
    For X = 0 To UBound(Nums)
      If Not (Nums(X) Like "##-##-##" Or Nums(X) Like "##-##-####" Or _
              Nums(X) Like "#-##-##" Or Nums(X) Like "#-##-####" Or _
              Nums(X) Like "##-#-##" Or Nums(X) Like "##-#-####" Or _
              Nums(X) Like "#-#-##" Or Nums(X) Like "#-#-####") _
              Then Nums(X) = ""
    Next
    Cells(R, "B").Value = Application.Trim(Join(Nums))
  Next
  Columns("B").TextToColumns , xlDelimited, , , 0, 0, 0, 1
End Sub

It picked up all 8 instances of date.

http://screencast.com/t/03TKpe0y71