vba help - find max date

[Mallesh23]

Hi Team,

Need vba help to split and find max date.

Column A is input Column , expected outputis Column B.

Book1
	A	B
1	Date	Max Date
2	30-01-2020/02-09-2019/16-09-2019	30/01/2020
3	04-09-2019/18-09-2019/14-10-2019/23-01-2020	23/01/2020
4	18-09-2019/30-09-2019/05-11-2019/23-01-2020	23/01/2020
5	16-09-2019/25-09-2019/04-11-2019	04/11/2019
6	01-10-2019/23-01-2020/09-10-2019/04-11-2019	23/01/2020
7	01-10-2019/28-10-2019/30-01-2020/11-11-2019	30/01/2020
8	03-02-2020/01-10-2019/30-01-2020	03/02/2020
Sheet1

Thanks
mg

 

[Dossfm0q]

try this

Sub test()

    Dim ar As Variant
    Dim i As Long
    Dim maxdate As Date
    Dim arrdate As Long
    
    For i = 2 To 10
   arrdate = 0
        If Cells(i, 1).Value <> "" And Len(Cells(i, 1).Value) > 5 Then
            ar = Split(Cells(i, 1).Value, "/")
                For d = LBound(ar) To UBound(ar)
                If CDate(ar(d)) > arrdate Then
                    arrdate = CDate(ar(d))
                End If
                  
                Next
                 maxdate = arrdate
                Cells(i, 2).Value = maxdate
        End If
  
    Next i

End Sub

 

[Mallesh23]

Hi DossFm0q,

Thanks for your help, it worked. ?


Thanks
mg

 

[Dossfm0q]

You are welcome

 

[Peter_SSs]

I have data of more than 1 lakh rows.

.... speed is concerned.

Given the above, you may wish to try this version which for me is almost 10 times faster. With 80,000 rows of data like the samples, 0.47 secs v 4.4 secs

Sub Max_Date_v2()
  Dim a As Variant, b As Variant, itm As Variant
  Dim i As Long, Mx As Long
  
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If Len(a(i, 1)) > 9 Then
      Mx = 0
      For Each itm In Split(a(i, 1), "/")
        If CDate(itm) > Mx Then Mx = CDate(itm)
      Next itm
      b(i, 1) = Mx
    End If
  Next i
  With Range("B2").Resize(UBound(b))
    .NumberFormat = "dd/mm/yyyy"
    .Value = b
  End With
End Sub

 

[Mallesh23]

Hi Peter,

Thanks for sharing one more option , millions of thanks for your help.
I liked the code. ?


Thanks
mg

 

[Peter_SSs]

Cheers. Actually I posted a version that I didn't mean to. It works fine, but I had meant to post this one which has a couple of minor changes.

Sub Max_Date_v3()
  Dim a As Variant, b As Variant, itm As Variant
  Dim i As Long
  Dim dMax As Date
  
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If Len(a(i, 1)) > 9 Then
      dMax = 0
      For Each itm In Split(a(i, 1), "/")
        If CDate(itm) > dMax Then dMax = CDate(itm)
      Next itm
      b(i, 1) = dMax
    End If
  Next i
  Range("B2").Resize(UBound(b)).Value = b
End Sub

 

[Mallesh23]

Hi Peter,

Thanks once again , it also worked !
I like your approach storing output in Array and printing later in excel, in one go. ?



Thanks
mg

 

[Peter_SSs]

I like your approach storing output in Array and printing later in excel, in one go.

Reading all the original values into an array in one go, storing all the results in an array & printing it once to the sheet is why this code is so much faster than the other one. This code only interacts with the worksheet only twice as just described. The other code interacts with the worksheet 4 times per row (or twice if blank or dash) so for 80,000 rows there are between 160,000 and 320,000 code/worksheet interactions compared to 2.