Solved

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

Posted on 2013-12-12
24
308 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 13
  • 8
  • 3
24 Comments
 
LVL 52

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 52

Expert Comment

by:Rgonzo1971
ID: 39715939
Hi

I meant are they like that

20121213 or 13.12.2013 or Dez 13, 2013

Regards
0
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 
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 52

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 52

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 52

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
 

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 52

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 52

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 52

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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

617 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