reformat date entries with the help of a macro and the text formula

Hi,

What format  do the dates have?

Regards

Hi Rgonzo 1971.

They are formatted as text.

Regards, Andreas

Hi

I meant are they like that

20121213 or 13.12.2013 or Dez 13, 2013

Regards

You just need to use DateValue.

=Text(DateValue(A2),"yyyymmdd")

Select allOpen in new window

However, you might just want to use

=DateValue(A2)

Select allOpen in new window

, and then put a cell formatting on it.

Note that this might be locale-dependent.

Edit: If they are in formats that cannot be parsed by Excel, then you have to use the if function and parse it yourself.

Hi,

if already YYYYMMDD

pls try

Sub Macro5()

For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
    rng.Value = CDbl(rng.Value)
Next
For Each c In Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
    rng.Value = CDbl(rng.Value)
Next
End Sub

Select allOpen in new window

Regards

Hi Rgonzo,

thank you very much for your quick help. As a matter of fact, they are all like
... 13.12.2013, 17.04.2012, 15.09.2013 (all formatted as pure text).

So could you please re-write the above code to match my requirements. That would be great and much appreciated.

Thank you, Regards, Andreas

Hi limweizhong:

thank you very much for your quick help. Could you please incorporate this formula...

=Text(DateValue(A2),"yyyymmdd") into my requirements, ie. run this formula on all of the worksheets on the currently active workbook on Column C and Column D

Thank you very much in advance.

Regards, Andreas

Hi,

pls try text as YYYMMDD

Sub Macro5()
'
' Macro5 Macro

For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
    FormatDate (c)
Next
For Each c In Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
    FormatDate (c)
Next
End Sub

Sub FormatDate(ByVal rng As Range)

    arrDate = Split(rng.Value, ".")
    myDate = DateSerial(arrDate(2), arrDate(1), arrDate(0))
    rng.Value = Format(myDate, "YYYYMMDD")
End Sub

Select allOpen in new window

Or  Date as YYYMMDD

Sub FormatDate1(ByVal rng As Range)
    arrDate = Split(rng.Value, ".")
    myDate = DateSerial(arrDate(2), arrDate(1), arrDate(0))
    rng.Value = CDbl(myDate)
    rng.NumberFormat = "YYYYMMDD"
End Sub

Sub Macro6()
'
' Macro5 Macro

For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
    FormatDate1 (c)
Next
For Each c In Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
    FormatDate1 (c)
Next
End Sub

Select allOpen in new window

Regards

=IF(ISERR(VALUE(A1)),IF(ISERROR(FIND(".",A1)),DATEVALUE(MID(A1,FIND(" ",A1),FIND(",",A1)-FIND(" ",A1))&" "&LEFT(A1,FIND(" ",A1))&RIGHT(A1,LEN(A1)-FIND(",",A1))),DATE(RIGHT(A1,LEN(A1)-FIND(".",A1,FIND(".",A1)+1)),MID(A1,FIND(".",A1)+1,FIND(".",A1,FIND(".",A1)+1)-FIND(".",A1)-1),LEFT(A1,FIND(".",A1)-1))),DATE(LEFT(A1,LEN(A1)-4),MID(A1,LEN(A1)-3,2),RIGHT(A1,2)))

Select allOpen in new window

Replace A1 with the reference of your first cell, then you can drag the formula.

Hi Rgonzo,

I used the below approach. Works fine, just great. Thank you very much for your great support.

There is one thing. How can I apply this to all worksheets of the currently active workbook in one go.

Thank you, Regards, Andreas




Sub FormatDate1(ByVal rng As Range)
    arrDate = Split(rng.Value, ".")
    myDate = DateSerial(arrDate(2), arrDate(1), arrDate(0))
    rng.Value = CDbl(myDate)
    rng.NumberFormat = "YYYYMMDD"
End Sub

Sub Macro6()
'
' Macro5 Macro

For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
    FormatDate1 (c)
Next
For Each c In Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
    FormatDate1 (c)
Next
End Sub

Hi,

you could use

Sub Macro6()
'
' Macro5 Macro

For Each sh In ActiveWorkbook.Sheets
    sh.Activate
    For Each c In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
        FormatDate1 (c)
    Next
    For Each c In sh.Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
        FormatDate1 (c)
    Next

Next
End Sub

Select allOpen in new window

Regards

Hi Rgonzo,

I am truly impressed. Works like a charm. Great Job, thank you very much for it.

One more ISSUE: If I wanted to run this macro on all the excel files in the folder C:\MyFiles\...

Would that be a major re-writing of the code so that all of the excel files in that folder get worked on. I could post a new question for that.

Hi limeweizhong:

thank you very much for your quick help. Will test it and then let you know.

Regards, Andreas

Hi,

pls try

Sub Macro6()
'
' Macro5 Macro

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
    .Title = "Select the folder"
    If .Show = True Then
        FolderName = .SelectedItems(1)
    Else
        MsgBox "No Folder selected!", vbOKOnly, "File Export"
        Exit Sub
    End If
End With

Filename = Dir(FolderName & "\")
While (Filename <> "")
    If Filename Like "*.xls*" Then
        For Each sh In ActiveWorkbook.Worksheets
            For Each c In sh.Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
                FormatDate1 (c)
            Next
            For Each c In sh.Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
                FormatDate1 (c)
            Next
        Next
    End If
    Filename = Dir
Wend
End Sub

Select allOpen in new window

Regards

Hi Rgonzo,

I am afraid to tell you that it does not do a thing. Since this was not part of my initial requirements, it is up to you, either work on it further or leave it at that state.

Regards, Andreas

Hi,

Sorry, I forgot o open and close the files

Sub Macro6()
'
' Macro5 Macro

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
    .Title = "Select the folder"
    If .Show = True Then
        FolderName = .SelectedItems(1)
    Else
        MsgBox "No Folder selected!", vbOKOnly, "File Export"
        Exit Sub
    End If
End With


Filename = Dir(FolderName & "\")
While (Filename <> "")
    If Filename Like "*.xls*" Then
        Set wbk = Workbooks.Open(FolderName & "\" & Filename)
        For Each sh In wbk.Worksheets
            For Each c In sh.Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
                FormatDate1 (c)
            Next
            For Each c In sh.Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
                FormatDate1 (c)
            Next
        Next
        wbk.Save
        wbk.Close
    End If
    Filename = Dir
Wend
End Sub

Select allOpen in new window

Regards

ok, great, I will give a try soon. Thank you very much for your great help. I really appreciate it.

Regards, andreas

Hi Rgonzo,

ok, great the looping works great, BUT strange enough, only the first worksheet of all the files get worked on, the others, not.

I cannot understand why since your code seems perfect to me.

Any idea why.

Regards, Andreas

Hi Rgonzo,

great, this did the trick. Works like a charm. I am really happy with this code.
Thank you very much for your great and professional help. Regards, Andreas

Hi limweizhong,

your code also works just great. Thank you very much for your superb and professional help.

I tweaked it just a little bit on line 5: Set w = ActiveWorkbook

I now will try to incorporate RGonzo's folder picker into your code. If I do not succeed I will get back to you. Again, thank you very much for your great support.

Regards, Andreas

Hi limweizhong,

your code also works just great. Thank you very much for your superb and professional help.

I tweaked it just a little bit on line 5: Set w = ActiveWorkbook

I now will try to incorporate RGonzo's folder picker into your code. If I do not succeed I will get back to you. Again, thank you very much for your great support.

Regards, Andreas

Hi limweizhong,

ok, got it integrated.

Dear both,

it is really hard to award points equitably. Both approaches work fine for me.

Again, thank you very much for your great and professional support.

I really appreciate.

Regards, Andreas