Solved

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

Posted on 2013-12-12
24
268 Views
Last Modified: 2013-12-14
Dear Experts:

On the current workbook with many worksheets ...

... there are date entries in Column C and D in all of the worksheets.

They are formatted as pure text.

By means of a macro I would like to re-format these date entries in Column C and D with the following formula : Text(A2;"JJJJMMDD")

Could somebody please help me with that.

Thank you very much in advance. Regards, Andreas
0
Comment
Question by:AndreasHermle
  • 13
  • 8
  • 3
24 Comments
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39715922
Hi,

What format  do the dates have?

Regards
0
 

Author Comment

by:AndreasHermle
ID: 39715928
Hi Rgonzo 1971.

They are formatted as text.

Regards, Andreas
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39715939
Hi

I meant are they like that

20121213 or 13.12.2013 or Dez 13, 2013

Regards
0
 
LVL 6

Expert Comment

by:limweizhong
ID: 39715940
You just need to use DateValue.
=Text(DateValue(A2),"yyyymmdd")

Open in new window


However, you might just want to use
=DateValue(A2)

Open 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.
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39715943
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

Open in new window

Regards
0
 

Author Comment

by:AndreasHermle
ID: 39715954
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
0
 

Author Comment

by:AndreasHermle
ID: 39715956
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
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39715972
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

Open 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

Open in new window

Regards
0
 
LVL 6

Expert Comment

by:limweizhong
ID: 39715986
=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)))

Open in new window


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

Author Comment

by:AndreasHermle
ID: 39715998
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
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39716017
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

Open in new window

Regards
0
 
LVL 6

Assisted Solution

by:limweizhong
limweizhong earned 200 total points
ID: 39716032
Try this:
Sub MakeDates()
    Dim w As Workbook, s As Worksheet, c As Range, r, r2$, n&
'    For Each w In Workbooks
'        w.Activate
    w = ActiveWorkbook
        For Each s In w.Worksheets
            s.Select
            ActiveSheet.UsedRange
            n = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
            For Each c In Range(Cells(1, 3), Cells(n, 4)).Cells
                If VarType(c) <> vbString Then GoTo nextc
                r2 = c
                r = Split(r2, ".")
                If UBound(r) = 2 Then
                    If IsNumeric(r(0)) And IsNumeric(r(1)) And IsNumeric(r(2)) And Len(r(2)) = 4 Then c = DateSerial(r(2), r(1), r(0))
                ElseIf UBound(r) = 0 Then
                    If IsNumeric(r2) And Len(r2) = 8 Then
                        c = DateSerial(Left(r2, 4), Mid(r2, 5, 2), Right(r2, 2))
                    Else
                        On Error Resume Next
                        c = DateValue(r2)
                        On Error GoTo 0
                    End If
                End If
nextc:
            Next c
        Next s
'    Next w
End Sub

Open in new window


Backup first; no guarantees!
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:AndreasHermle
ID: 39716065
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
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39716096
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

Open in new window

Regards
0
 

Author Comment

by:AndreasHermle
ID: 39716253
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
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39716369
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

Open in new window

Regards
0
 

Author Comment

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

Regards, andreas
0
 

Author Comment

by:AndreasHermle
ID: 39716575
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
0
 
LVL 48

Accepted Solution

by:
Rgonzo1971 earned 300 total points
ID: 39716599
HI,

Corrected Code

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
            sh.Activate
            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
        Next
        wbk.Save
        wbk.Close
    End If
    Filename = Dir
Wend

Open in new window

Regards
0
 

Author Comment

by:AndreasHermle
ID: 39718987
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
0
 

Author Comment

by:AndreasHermle
ID: 39719004
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
0
 

Author Comment

by:AndreasHermle
ID: 39719042
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
0
 

Author Comment

by:AndreasHermle
ID: 39719086
Hi limweizhong,

ok, got it integrated.
0
 

Author Closing Comment

by:AndreasHermle
ID: 39719090
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
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now