Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 313
  • Last Modified:

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

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
AndreasHermle
Asked:
AndreasHermle
  • 13
  • 8
  • 3
2 Solutions
 
Rgonzo1971Commented:
Hi,

What format  do the dates have?

Regards
0
 
AndreasHermleAuthor Commented:
Hi Rgonzo 1971.

They are formatted as text.

Regards, Andreas
0
 
Rgonzo1971Commented:
Hi

I meant are they like that

20121213 or 13.12.2013 or Dez 13, 2013

Regards
0
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!

 
limweizhongCommented:
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
 
Rgonzo1971Commented:
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
 
AndreasHermleAuthor Commented:
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
 
AndreasHermleAuthor Commented:
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
 
Rgonzo1971Commented:
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
 
limweizhongCommented:
=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
 
AndreasHermleAuthor Commented:
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
 
Rgonzo1971Commented:
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
 
limweizhongCommented:
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
 
AndreasHermleAuthor Commented:
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
 
Rgonzo1971Commented:
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
 
AndreasHermleAuthor Commented:
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
 
Rgonzo1971Commented:
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
 
AndreasHermleAuthor Commented:
ok, great, I will give a try soon. Thank you very much for your great help. I really appreciate it.

Regards, andreas
0
 
AndreasHermleAuthor Commented:
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
 
Rgonzo1971Commented:
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
 
AndreasHermleAuthor Commented:
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
 
AndreasHermleAuthor Commented:
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
 
AndreasHermleAuthor Commented:
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
 
AndreasHermleAuthor Commented:
Hi limweizhong,

ok, got it integrated.
0
 
AndreasHermleAuthor Commented:
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

Industry Leaders: 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!

  • 13
  • 8
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now