vba help - Split two dates and pick max date

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
843
Office Version
  1. 2010
Platform
  1. Windows
Hi Team,

Need your help to split date Column(A) if there are two dates in cell.
find max dates and it will be output. and add grace 15 days to each day.

these are two pattern needs to split.
28-04-2020/09-05-2020
01-07-2020-02-06-2020


Below is my attempted code, Covered only "/" Seperator.
macro needs to handle Pattern==> 01-07-2020-02-06-2020


VBA Code:
Sub test()

    Dim arr_date As Variant
    arr_date = Range("a2:a11").Value
    Dim AddExtraDays As Long
   
   ' Read through the data, if two dates find max date ,add 15 days to each date
        
        AddExtraDays = 15
    
    Dim dict As New Scripting.Dictionary
        dict.RemoveAll
        dict.CompareMode = TextCompare
    
        Dim i As Long
        Dim strdate As Date
    
    '--------------
    On Error Resume Next
    For i = LBound(arr_date, 1) To UBound(arr_date, 1)
        If Len(arr_date(i, 1)) > 12 Then
            strdate = Split(arr_date(i, 1), "/")(1)
            arr_date(i, 1) = CDate(strdate) + AddExtraDays
        Else
            arr_date(i, 1) = CDate(arr_date(i, 1)) + AddExtraDays
            End If
    Next i
    On Error GoTo 0
       
    
    Range("b2:b11").Value = arr_date

End Sub

Below is my data with expected output in Column B.

VBA Code:
[RANGE=rs:11|cs:2|w:Book28|cls:xl2bb-127|s:Sheet1|tw:322][XR][XH][/XH][XH=w:112]A[/XH][XH=w:210]B[/XH][/XR][XR][XH]1[/XH][XD=h:l|bc:FFFF00|ch:14.5|cls:bb]Date Column[/XD][XD=h:l|bc:FFD966|cls:bb]Expected Output After Split + 15 Days Added[/XD][/XR][XR][XH]2[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb]28-04-2020/09-05-2020[/XD][XD=h:c|bc:00B050|cls:bl bt br bb|tx:24/05/2020]24/05/2020[/XD][/XR][XR][XH]3[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb]01-07-2020/02-07-2020[/XD][XD=h:c|bc:00B050|cls:bl bt br bb|tx:17/07/2020]17/07/2020[/XD][/XR][XR][XH]4[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb|tx:31/08/2020]31/08/2020[/XD][XD=h:c|cls:bl bt br bb|tx:15/09/2020]15/09/2020[/XD][/XR][XR][XH]5[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb|tx:31/07/2019]31/07/2019[/XD][XD=h:c|cls:bl bt br bb|tx:15/08/2019]15/08/2019[/XD][/XR][XR][XH]6[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb|tx:02/09/2020]02/09/2020[/XD][XD=h:c|cls:bl bt br bb|tx:17/09/2020]17/09/2020[/XD][/XR][XR][XH]7[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb|tx:10/09/2020]10/09/2020[/XD][XD=h:c|cls:bl bt br bb|tx:25/09/2020]25/09/2020[/XD][/XR][XR][XH]8[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb|tx:18/09/2020]18/09/2020[/XD][XD=h:c|cls:bl bt br bb|tx:03/10/2020]03/10/2020[/XD][/XR][XR][XH]9[/XH][XD=h:l|ch:14.5|cls:bt br bb|tx:24/09/2020]24/09/2020[/XD][XD=h:c|cls:bl bt br bb|tx:09/10/2020]09/10/2020[/XD][/XR][XR][XH]10[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb]01-07-2020-02-06-2020[/XD][XD=h:c|bc:00B050|cls:bl bt br bb|tx:16/07/2020]16/07/2020[/XD][/XR][XR][XH]11[/XH][XD=h:l|v:m|ch:14.5|cls:bl bt br bb]01-07-2020-02-08-2020[/XD][XD=h:c|bc:00B050|cls:bl bt br bb|tx:17/08/2020]17/08/2020[/XD][/XR][/RANGE]


Thanks
mg
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Dave Patton

Well-known Member
Joined
Feb 15, 2002
Messages
4,573
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
T202011a.xlsm
AB
228-04-2020/09-05-202009-May-2020
301-07-2020-02-06-202001-Jul-2020
1f
Cell Formulas
RangeFormula
B2:B3B2=MAX(LEFT(A2,10),RIGHT(A2,10))
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
843
Office Version
  1. 2010
Platform
  1. Windows
Hi Dave,

Thanks for your help, I am looking help in vba,

Below is a table.

Book28
AB
1Date ColumnExpected Output After Split + 15 Days Added
228-04-2020/09-05-202024/05/2020
301-07-2020/02-07-202017/07/2020
431/08/202015/09/2020
531/07/201915/08/2019
602/09/202017/09/2020
710/09/202025/09/2020
818/09/202003/10/2020
924/09/202009/10/2020
1001-07-2020-02-06-202016/07/2020
1101-07-2020-02-08-202017/08/2020
Sheet1


Thanks
mg
 

Dave Patton

Well-known Member
Joined
Feb 15, 2002
Messages
4,573
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
T202011a.xlsm
AB
1
228-04-2020/09-05-202024-May-2020
301-07-2020-02-06-202016-Jul-2020
4
5
1f
Cell Formulas
RangeFormula
B2:B3B2=MAX(LEFT(A2,10),RIGHT(A2,10))+15
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
843
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Hi Dave,

Formula worked , But I am doing all activity via macro. my data are in different workbooks.
hence taking data into Array and working.

Below is my attempted Code.

VBA Code:
Sub test()

    Dim arr_date As Variant
    arr_date = Range("a2:a11").Value
    Dim AddExtraDays As Long
   
   ' Read through the data, if two dates find max date ,add 15 days to each date
        
        AddExtraDays = 15
    
    Dim dict As New Scripting.Dictionary
        dict.RemoveAll
        dict.CompareMode = TextCompare
    
        Dim i As Long
        Dim strdate As Date
    
    '--------------
    On Error Resume Next
    For i = LBound(arr_date, 1) To UBound(arr_date, 1)
        If Len(arr_date(i, 1)) > 12 Then
            strdate = Split(arr_date(i, 1), "/")(1)
            arr_date(i, 1) = CDate(strdate) + AddExtraDays
        Else
            arr_date(i, 1) = CDate(arr_date(i, 1)) + AddExtraDays
            End If
    Next i
    On Error GoTo 0
       
    
    Range("b2:b11").Value = arr_date


Column A is input file.

Book28
AB
1Date ColumnExpected Output After Split + 15 Days Added
228-04-2020/09-05-202024/05/2020
301-07-2020/02-07-202017/07/2020
431/08/202015/09/2020
531/07/201915/08/2019
602/09/202017/09/2020
710/09/202025/09/2020
818/09/202003/10/2020
924/09/202009/10/2020
1001-07-2020-02-06-202016/07/2020
1101-07-2020-02-08-202017/08/2020
Sheet1


Thanks
mg
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
What about this simpler approach?

VBA Code:
Sub test2()
  Dim arr_date As Variant
  Dim AddExtraDays As Long, i As Long
  Dim Date1 As Date, Date2 As Date
  
  arr_date = Range("a2:a11").Value
  AddExtraDays = 15
  For i = 1 To UBound(arr_date, 1)
    Date1 = DateValue(Left(arr_date(i, 1), 10))
    Date2 = DateValue(Right(arr_date(i, 1), 10))
    arr_date(i, 1) = IIf(Date1 > Date2, Date1, Date2) + 15
  Next i
  Range("b2:b11").Value = arr_date
End Sub
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
843
Office Version
  1. 2010
Platform
  1. Windows
Hi Peter

Thats Great ! , it worked, So short code,

Thanks you so much for help ! 🕺(y)


Thanks
mg
 

Watch MrExcel Video

Forum statistics

Threads
1,123,239
Messages
5,600,486
Members
414,383
Latest member
konmtu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top