if a cell contains specifc content, other cell to be replaced by this content

[Claire9079]

Hi Guys,

i am new to VBA. Would be much appreciated if you could help me with this!!

I have a table with list of consultant names and their start and end date. The lastest and correct date on the spreadsheet i received is alwaysi ncluded in the Name. I would like a VBA to be able to find this date and populate into the columns "Start date" and "end date" on the right. Examples below.

Before

Name	Start date	end date
Emily	01/01/2021	31/12/2021
Jason (09/06/2021 - 20/06/2021)	01/01/2021	31/12/2021
Mike	01/01/2021	31/12/2021

After

Name	Start date	end date
Emily	01/01/2021	31/12/2021
Jason (09/06/2021 - 20/06/2021)	09/06/2021	20/06/2021
Mike (01/06/2021 - 10/06/2021)	01/06/2021	10/06/2021

is it possible to do this? Thanks for your help in advance!!

 

[Claire9079]

Sorry the After should be like this

After

Name	Start date	end date
Emily	01/01/2021	31/12/2021
Jason	09/06/2021	20/06/2021
Mike	01/06/2021	10/06/2021

Thanks for your help in advance!!
Claire

 

[kweaver]

Is there a default date when one is missing in the parentheses?

(also, please update your profile to reflect what version of Excel you run)

 

[kweaver]

Maybe this?

Sub Claire9079()
Dim lr As Long, i As Long, str As String, dts() As String
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
 If 0 <> InStr(1, Range("A" & i), "(") Then
   str = Left(Right(Range("A" & i), 24), 23)
   dts = Split(str, " - ")
   Cells(i, "B") = dts(0)
   Cells(i, "C") = dts(1)
 Else
   Cells(i, "B") = "01/01/2021"
   Cells(i, "C") = "31/12/2021"
 End If
Next i
End Sub

I have a minor problem when the dates aren't my format (US). SIGH

 

[Claire9079]

Maybe this?

Sub Claire9079()
Dim lr As Long, i As Long, str As String, dts() As String
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
 If 0 <> InStr(1, Range("A" & i), "(") Then
   str = Left(Right(Range("A" & i), 24), 23)
   dts = Split(str, " - ")
   Cells(i, "B") = dts(0)
   Cells(i, "C") = dts(1)
 Else
   Cells(i, "B") = "01/01/2021"
   Cells(i, "C") = "31/12/2021"
 End If
Next i
End Sub

I have a minor problem when the dates aren't my format (US). SIGH

Many thanks for your help!!! It works! Would it be possible after running the macro, the dates in this cell is also removed and only name left?

Jason (09/06/2021 - 20/06/2021) --> Jason


Thanks
CLaire

 

[kweaver]

How about:

Sub Claire9079()
Dim lr As Long, i As Long, str As String, dts() As String
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
 If 0 <> InStr(1, Range("A" & i), "(") Then
   str = Left(Right(Range("A" & i), 24), 23)
   dts = Split(str, " - ")
   Cells(i, "B") = dts(0)
   Cells(i, "C") = dts(1)
   dts = Split(Range("A" & i))
   Cells(i, "A") = dts(0)
 Else
   Cells(i, "B") = "01/01/2021"
   Cells(i, "C") = "31/12/2021"
 End If
Next i
End Sub

 

[Claire9079]

That's perfect! Thanks so much for your help!!!

 

[JackDanIce]

An alternative suggestion:

[code]
Sub Split_Data()

    Dim delims As Variant: delims = Array(" (", " - ", ")")
    Dim fillers(3) As Variant
    Dim LR As Long: LR = Cells(Rows.Count, 1).End(xlUp).Row - 1
    Dim x As Long
        
    fillers(0) = "Start Date"
    fillers(1) = "End Date"
    fillers(2) = #1/1/2021#
    fillers(3) = #12/31/2021#
    
    Application.ScreenUpdating = False
    
    For x = LBound(delims) To UBound(delims)
        Cells(2, 1).Resize(LR).Replace delims(x), ","
    Next x

    With Cells(2, 1).Resize(LR)
        .TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, Comma:=True, FieldInfo:=Array(Array(1, 1), Array(2, 4), Array(3, 4)), TrailingMinusNumbers:=True
        
        .Offset(-1, 1).Resize(1, 2).Value = Array(fillers(0), fillers(1))
        .Offset(, 1).SpecialCells(xlCellTypeBlanks).Value = fillers(2)
        .Offset(, 2).SpecialCells(xlCellTypeBlanks).Value = fillers(3)
        
        .Resize(, 3).EntireColumn.AutoFit
    End With
    
    Application.ScreenUpdating = True
    
    Erase delims: Erase fillers
End Sub