Edit 3: Revised to account for no date in string. If so, current date will be inserted:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, LastRow
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, "A").Value = "" And _
Application.CountA(Range("A" & i & ":" & "IV" & i)) > 0 Then
Cells(i, "B").Value = Format(Date, "mm/dd/yyyy")
End If
If Cells(i, "A").Value <> "" Then
dMark = Application.Find("/", Cells(i, "A"), 1)
If Len(Cells(i, "A")) < 12 Then
Cells(i, "B").Value = Cells(i, "A").Value
ElseIf IsError(Application.Find("/", Cells(i, "A"), 1)) Then
Cells(i, "B").Value = Format(Date, "mm/dd/yyyy")
Else
Cells(i, "B").Value = Format(Mid(Cells(i, "A"), _
dMark - 2, 10), "mm/dd/yyyy")
End If
End If
Next
End Sub
'==============
Edit2: Revised to handle an entire column:
Here is a VBA macro that will extract the date for every row in column A and insert it into the same row in column B.
If you wish to use different columns for your data, modify the column references thusly:
Change all "A" references to the column letter containing your text string, i.e. "F"
Change all "B" references to the column to insert the extracted date in, i.e. "H"
Then, copy the modified code to the clipboard:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, LastRow
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, "A").Value <> "" Then
dmark = Application.Find("/", Cells(i, "A"), 1)
If Len(Cells(i, "A")) < 12 Then
Cells(i, "B").Value = Cells(i, "A").Value
Else
Cells(i, "B").Value = Format(Mid(Cells(i, "A"), _
dmark - 2, 10), "mm/dd/yyyy")
End If
End If
Next
End Sub
Select the appropriate worksheet and right click the sheet tab.
Select 'View Code'
Paste the code into the sheet module editing area to the right.
Close the VBE and return to the worksheet.
The date will be extracted on any selection_change event.
It makes no difference where the date is in the string, nor the date structure. Works with 1 or 2 digit months and days.