VBA Code to extract date range from Cell?

[Coyotex3]

Hi, trying to figure out a code which will allow me to extract a date range from a cell. I was able to do it using Formulas(TextBefore and TextAfter) but would like to be able to insert this inside of a larger code.

Ideally, I'd like to go from this:

Book2
	A	B	C	D
1	Account Type	Notes	Total	Date Range
2	Bills	1357888 (1/01/2020-2/01/2020)	1000
3	Bills	Monthly (1/01/2020-2/01/2020)	500
4	Bills	Expenses (02/01/2021-3/01/2021)	1000
5	Bills	6000 (1/01/2020-2/01/2020)	500
Sheet1

To this:

Book2
	A	B	C	D
1	Account Type	Notes	Total	Date Range
2	Bills	1357888 (1/01/2020-2/01/2020)	1000	1/01/2020-2/01/2020
3	Bills	Monthly (1/01/2020-2/01/2020)	500	1/01/2020-2/01/2020
4	Bills	Expenses (02/01/2021-3/01/2021)	1000	02/01/2021-3/01/2021
5	Bills	6000 (1/01/2020-2/01/2020)	500	1/01/2020-2/01/2020
Sheet1

Note: Range D3 contains a different date format than the other cells in Column D. The date ranges will sometimes be written as 01/01/2020 or 1/1/2020 or 01/1/2020 or 1/01/2020 etc. Is there a way of making excel recognize the different date formats and extracting them?

 

[James006]

Hi,
You can test following formula :

=MID(B2,FIND("(",B2)+1,LEN(B2)-FIND("(",B2)-1)

 

[Coyotex3]

Hi,
You can test following formula :

=MID(B2,FIND("(",B2)+1,LEN(B2)-FIND("(",B2)-1)

Hi James, thank you for this formula. It worked along with the one below. Ideally I'd like to be able to do it with VBA as this will be placed inside of a larger Sub.

=TEXTAFTER(TEXTBEFORE(B2,")"),"(")

 

[Skyybot]

Try this and see if it works for you.

Sub getDateRange()
Dim wb As Workbook, sht As Worksheet, dRng As Range, fRng As Range, cell As Range
Dim i As Long, x As Long, y As Long
Dim d1 As String, d2 As String, dFull As String
Set wb = ThisWorkbook: Set sht = wb.Worksheets("Sheet1")
Set dRng = sht.Range(Cells(2, 2), Cells(sht.UsedRange.Rows.Count, 2))
Set fRng = sht.Range(Cells(2, 4), Cells(sht.UsedRange.Rows.Count, 4))
For Each cell In dRng
    dFull = Right(cell.Value, Len(cell.Value) - InStr(1, cell.Value, "("))
    dFull = Left(dFull, Len(dFull) - 1)
    d1 = Left(dFull, InStr(1, dFull, "-") - 1)
    d2 = Right(dFull, Len(dFull) - InStr(1, dFull, "-"))
    cell.Offset(0, 2).Value = d1 & "-" & d2
Next cell
End Sub

 

[Coyotex3]

Try this and see if it works for you.

Sub getDateRange()
Dim wb As Workbook, sht As Worksheet, dRng As Range, fRng As Range, cell As Range
Dim i As Long, x As Long, y As Long
Dim d1 As String, d2 As String, dFull As String
Set wb = ThisWorkbook: Set sht = wb.Worksheets("Sheet1")
Set dRng = sht.Range(Cells(2, 2), Cells(sht.UsedRange.Rows.Count, 2))
Set fRng = sht.Range(Cells(2, 4), Cells(sht.UsedRange.Rows.Count, 4))
For Each cell In dRng
    dFull = Right(cell.Value, Len(cell.Value) - InStr(1, cell.Value, "("))
    dFull = Left(dFull, Len(dFull) - 1)
    d1 = Left(dFull, InStr(1, dFull, "-") - 1)
    d2 = Right(dFull, Len(dFull) - InStr(1, dFull, "-"))
    cell.Offset(0, 2).Value = d1 & "-" & d2
Next cell
End Sub

Hi, Thank you for your reply.

I'm getting Run time Error 1004 on this line

Set dRng = sht.Range(Cells(2, 2), Cells(sht.UsedRange.Rows.Count, 2))

 

[James006]

Hi,
With your formula transposed in a macro, you can test

For i = 2 To 20
    Range("D" & i) = Evaluate("=TEXTAFTER(TEXTBEFORE(B" & i & ","")""),""("")")
Next i

 

[Alex Blakenburg]

You can probably add standardising the date format to @James006's evaluate function but here is another option.
Note: It assumes that the date is in the format of your region setting. If you need to reverse day & month it will need to be modified.

Sub SplitOutAndFormatDate()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim Rng As Range, destRng As Range
    Dim arr As Variant
    Dim dtFrom As Date, dtTo As Date
    Dim DateFormat As String
    Dim strSplit As Variant
    Dim LastRow As Long, i As Long
    
    Set wb = ActiveWorkbook
    Set sht = wb.Worksheets("Sheet1")       '<--- Change this to the name of your sheet or to ActiveSheet
    DateFormat = "dd/mm/yyyy"               '<--- Change to desired format
    
    LastRow = sht.Range("B" & Rows.Count).End(xlUp).Row
    With sht
        Set Rng = .Range("B2:D" & LastRow)
        arr = Rng.Value
    End With

    For i = 1 To UBound(arr)
        strSplit = Split(arr(i, 1), "(")
        strSplit = Split(Left(strSplit(1), Len(strSplit(1)) - 1), "-")
        dtFrom = DateValue(strSplit(1))
        dtTo = DateValue(strSplit(1))
        arr(i, 3) = Format(dtFrom, DateFormat) & "-" & Format(dtTo, DateFormat)
    Next i
    
    Rng.Columns(3) = Application.Index(arr, 0, 3)

End Sub

 

[Coyotex3]

Hi,
With your formula transposed in a macro, you can test

For i = 2 To 20
    Range("D" & i) = Evaluate("=TEXTAFTER(TEXTBEFORE(B" & i & ","")""),""("")")
Next i

Thank you James, this one works!

 

[Coyotex3]

You can probably add standardising the date format to @James006's evaluate function but here is another option.
Note: It assumes that the date is in the format of your region setting. If you need to reverse day & month it will need to be modified.

Sub SplitOutAndFormatDate()

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim Rng As Range, destRng As Range
    Dim arr As Variant
    Dim dtFrom As Date, dtTo As Date
    Dim DateFormat As String
    Dim strSplit As Variant
    Dim LastRow As Long, i As Long
   
    Set wb = ActiveWorkbook
    Set sht = wb.Worksheets("Sheet1")       '<--- Change this to the name of your sheet or to ActiveSheet
    DateFormat = "dd/mm/yyyy"               '<--- Change to desired format
   
    LastRow = sht.Range("B" & Rows.Count).End(xlUp).Row
    With sht
        Set Rng = .Range("B2:D" & LastRow)
        arr = Rng.Value
    End With

    For i = 1 To UBound(arr)
        strSplit = Split(arr(i, 1), "(")
        strSplit = Split(Left(strSplit(1), Len(strSplit(1)) - 1), "-")
        dtFrom = DateValue(strSplit(1))
        dtTo = DateValue(strSplit(1))
        arr(i, 3) = Format(dtFrom, DateFormat) & "-" & Format(dtTo, DateFormat)
    Next i
   
    Rng.Columns(3) = Application.Index(arr, 0, 3)

End Sub

Alex, thank you!

This one works as well!

 

[James006]

Glad to hear you have managed to solve your problem