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

Claire9079

New Member
Joined
Jun 3, 2019
Messages
6
Office Version
  1. 2007
Platform
  1. Windows
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
NameStart date end date
Emily01/01/202131/12/2021
Jason (09/06/2021 - 20/06/2021)01/01/202131/12/2021
Mike01/01/202131/12/2021

After
NameStart date end date
Emily01/01/202131/12/2021
Jason (09/06/2021 - 20/06/2021)09/06/202120/06/2021
Mike (01/06/2021 - 10/06/2021)01/06/202110/06/2021

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

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

Claire9079

New Member
Joined
Jun 3, 2019
Messages
6
Office Version
  1. 2007
Platform
  1. Windows
Sorry the After should be like this

After
NameStart dateend date
Emily01/01/202131/12/2021
Jason 09/06/202120/06/2021
Mike 01/06/202110/06/2021

Thanks for your help in advance!!
Claire
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
2,106
Office Version
  1. 365
  2. 2010
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

Well-known Member
Joined
May 8, 2018
Messages
2,106
Office Version
  1. 365
  2. 2010
Maybe this?

Code:
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
 
Last edited:

Claire9079

New Member
Joined
Jun 3, 2019
Messages
6
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Maybe this?

Code:
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

Well-known Member
Joined
May 8, 2018
Messages
2,106
Office Version
  1. 365
  2. 2010
How about:

Code:
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
 
Solution

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,890
Office Version
  1. 365
Platform
  1. Windows
An alternative suggestion:
VBA Code:
[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
 

Forum statistics

Threads
1,141,412
Messages
5,706,297
Members
421,439
Latest member
JordsdoExcel

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