Convert Tex to date

[Flowerstloft]

In the 3 date fields (in excel sheet) are cells, about 10%, with date value as text format (Jan 1 2010 12:00AM or Jan 25 2010 12:00AM) randomly. I am looking for VB code to search and reformat or convert any text formated date to date value

The range of the area (three columns of data) is not fixed.

Any help would be great!

Thank you in advance!!

 

[venkat1926]

SUPPOSE sheet 1 is like this (copy sheet1 to sheet 2 also from A1 for redoing)

Excel Workbook
	A	B	C
1	hdng1	hdng2	hdng3
2	10/1/2011	10/2/2011	10/3/2011
3	10/2/2011	10/3/2011	10/4/2011
4	Jan 1 2010 12:00AM	10/4/2011	10/5/2011
5	10/4/2011	10/5/2011	Jan 1 2010 12:00AM
6	Jan 25 2010 12:00AM	10/6/2011	10/7/2011
7	10/6/2011	10/7/2011	Jan 25 2010 12:00AM
Sheet1

run this macro test . I have used function already written in the reference quoted under the function codes)

Sub test()
Dim r As Range, r1 As Range, c As Range
Dim j As Long, k As Long, m As Long, n As Long, namemonth As String, monthnumber As Long
Set r = Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown))
Set r1 = r.SpecialCells(xlCellTypeConstants, 2)
'MsgBox r1.Address
For Each c In r1
'c.Select
j = WorksheetFunction.Search(" ", c)
k = WorksheetFunction.Search(" ", c, j + 1)
m = WorksheetFunction.Search(" ", c, k + 1)
n = m + 1
'MsgBox j
'MsgBox k
'MsgBox m
'MsgBox n
namemonth = Left(c, 3)
monthnumber = convertMonthName2Number(namemonth)
c = monthnumber & "/" & Mid(c, j + 1, k - j - 1) & "/" & Mid(c, k + 1, 4) & " " & Mid(c, m + 1, 5) & " " & Right(c, 2)
Next c
End Sub

Function convertMonthName2Number(monthName As String) As Integer
'REFERENCE  [U][B]http://www.codeforexcelandoutlook.com/blog/2009[/B][/U]/[U][B]04/converting-month-name-to-number/[/B][/U]
' try to convert month name to actual date type
Dim dtestr As String
dtestr = monthName & "/1/2000"

Dim dte As Date
On Error Resume Next
dte = CDate(dtestr)

If Err.Number <> 0 Then
  convertMonthName2Number = -999
  Exit Function
End If
On Error GoTo 0

convertMonthName2Number = Month(dte)
End Function

Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("a1")
End Sub

 

[Flowerstloft]

Thank you! It works

 

[Scott Huish]

Another possibility. Does this do what you want?

Sub Test()
Dim c As Range
For Each c In Range("A2").CurrentRegion
    c = Application.WorksheetFunction.Substitute(c, " ", ", ", 2)
    c = Replace(c, "A", " A")
    c = Replace(c, "P", " P")
    c.NumberFormat = "mm/dd/yy"
Next
End Sub

 

[Flowerstloft]

Hey Hotpepper,

WORKS AWESOME! Thank you!

 

[venkat1926]

HOTPEPPER

What an elegant and crisp solution. thanks a lot. how did I miss this in the web.

 

[Rick Rothstein]

Here is another possibility to consider...

Sub Mission()
  Dim Cell As Range
  For Each Cell In Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row)
    Cell.Value = CDate(Cell.Value)
    Cell.NumberFormat = "mm/dd/yyyy"
  Next
End Sub

 

[Rick Rothstein]

Sub Test()
Dim c As Range
For Each c In Range("A2").[COLOR=red]CurrentRegion[/COLOR]
    c = Application.WorksheetFunction.Substitute(c, " ", ", ", 2)
    [COLOR=red]c = Replace(c, "A", " A")[/COLOR]
    [COLOR=red]c = Replace(c, "P", " P")[/COLOR]
    c.NumberFormat = "mm/dd/yy"
Next
End Sub

Just a caution... since the CurrentRegion would include the header cells, then the two replace function calls will replace any A's and/or P's in those headers as well as in the cells below them.