Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

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

Posted on 2013-12-12
24
Medium Priority
?
312 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 53

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 53

Expert Comment

by:Rgonzo1971
ID: 39715939
Hi

I meant are they like that

20121213 or 13.12.2013 or Dez 13, 2013

Regards
0
Technology Partners: 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!

 
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 53

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 53

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 53

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 800 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 53

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 53

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 53

Accepted Solution

by:
Rgonzo1971 earned 1200 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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

972 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