formatting data

mcrmg
mcrmg used Ask the Experts™
on
Hi,

With EE's help, I am able to change the format using vba. The code is following
https://www.experts-exchange.com/questions/29120436/formatting-data.html
Sub FormatDates()
Dim cell As Range
Dim lr As Long
Dim dtStr As String
Application.ScreenUpdating = False
lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For Each cell In Range("A2:B" & lr)
    If cell <> "" And IsNumeric(cell.Value) And Evaluate(Len(cell.Text)) > 5 Then
        dtStr = cell.Value
        cell.Value = DateSerial(Left(dtStr, 4), Mid(dtStr, 5, 2), Right(dtStr, 2))
    End If
Next cell
Range("A2:B" & lr).NumberFormat = "mm/dd/yyyy"
Application.ScreenUpdating = True
End Sub

Open in new window


I found out there are some cells with strange data. See row 82. If I format this cell with NUMBER with no decimal. It will give me the date. This is my code, obviously, it is not working. I was wondering if EE could give me some directions. thanks

Sub FormatDates()
Dim cell As Range
Dim lr As Long
Dim dtStr As String
Application.ScreenUpdating = False

lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row



For Each cell In Range("A2:A" & lr)
    If cell <> "" And IsNumeric(cell.Value) And Evaluate(Len(cell.Text)) > 5 Then
        dtStr = cell.Value
        cell.Value = DateSerial(Left(dtStr, 4), Mid(dtStr, 5, 2), Right(dtStr, 2))
    Else
        Range("A" & lr).NumberFormat = "0"
        dtStr = cell.Value
        cell.Value = DateSerial(Left(dtStr, 4), Mid(dtStr, 5, 2), Right(dtStr, 2))
    End If
Next cell
Range("A2:A" & lr).NumberFormat = "mm/dd/yyyy"





Application.ScreenUpdating = True




End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Did you try my code from that thread?

Author

Commented:
forgot the file. sorry
Book1.xlsx
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
This works. It skips rows like 892 where there are values that are numbers with decimal points and/or commas.

Sub FormatDate()
    Dim cel As Range
    
    For Each cel In Range("A2:A" & ActiveSheet.UsedRange.Rows.Count)
        If InStr(1, cel.Text, ".") = 0 And InStr(1, cel.Text, ",") = 0 Then
            If Len(cel.Value2) > 5 Then
                If Not IsDate(cel.Value2) Then
                    cel = Left$(cel.Value2, 4) & "/" & Mid$(cel.Value2, 2, 2) & "/" & Right$(cel.Value2, 2)
                End If
            End If
            cel.NumberFormat = "mm/dd/yyyy"
        End If
    Next
    
End Sub

Open in new window

Learn SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

Author

Commented:
I combined two files into one. The code works for some but not all. Need direction. thanks
Book1.xlsx

Author

Commented:
The last part of column C is returning strange result. It should return 12/01/2012, instead, it returns 01/01/2012


thanks
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:

Author

Commented:
thanks for the quick reply. Please see the before and after comparison. Some values are odd and off. thanks
Book1.xlsx
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
Please give this a try...

Sub FormatDates()
Dim cell As Range
Dim lr As Long
Dim dtStr As String
Application.ScreenUpdating = False
lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For Each cell In Range("A2:C" & lr)
    If IsDate(cell) Then
        cell.NumberFormat = "mm/dd/yyyy"
    ElseIf Len(cell) > 5 And cell.NumberFormat <> "#,##0.00" And Not IsDate(cell.Value) Then
        dtStr = cell.Value
        cell.Value = DateSerial(Left(dtStr, 4), Mid(dtStr, 5, 2), Right(dtStr, 2))
        cell.NumberFormat = "mm/dd/yyyy"
    End If
Next cell
Application.ScreenUpdating = True
End Sub

Open in new window

Click the button called "Format Dates" on Sheet1 to run the code.
FormatDates.xlsm
Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
There was a mistake in my code. Note that this still looks for 3 columns, but I assume you can change line 4 as needed.

Sub FormatDate()
    Dim cel As Range
    
    For Each cel In Range("A2:C" & ActiveSheet.UsedRange.Rows.Count)
        If InStr(1, cel.Text, ".") = 0 And InStr(1, cel.Text, ",") = 0 Then
            If Len(cel.Value2) > 5 Then
                If Not IsDate(cel.Value2) Then
                    cel = Left$(cel.Value2, 4) & "/" & Mid$(cel.Value2, 5, 2) & "/" & Right$(cel.Value2, 2)
                End If
            End If
            cel.NumberFormat = "mm/dd/yyyy"
        End If
    Next
    
End Sub

Open in new window

Author

Commented:
Yes, it works fine. thank you.

Is there a way to past the code in Alt-F11 instead of pressing the button? It is giving me overflow error. What happens is that I receive these type of files every month and it is easier to past it in alt f11..thanks

Author

Commented:
thank you very much
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Is there a way to past the code in Alt-F11 instead of pressing the button? It is giving me overflow error. What happens is that I receive these type of files every month and it is easier to past it in alt f11..thanks
I'm sorry but I don't understand, so can you try again please? In particular please explain more about the overflow error.

Author

Commented:
The code you helped me works execllent..thank you
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
You’re welcome and I’m glad I was able to help.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
              Experts Exchange Top Expert VBA (current)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial