formatting data

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

mcrmgAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Did you try my code from that thread?
0
mcrmgAuthor Commented:
forgot the file. sorry
Book1.xlsx
0
Martin LissOlder than dirtCommented:
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

0
OWASP: Threats Fundamentals

Learn the top ten threats that are present in modern web-application development and how to protect your business from them.

mcrmgAuthor Commented:
I combined two files into one. The code works for some but not all. Need direction. thanks
Book1.xlsx
0
mcrmgAuthor Commented:
The last part of column C is returning strange result. It should return 12/01/2012, instead, it returns 01/01/2012


thanks
0
Martin LissOlder than dirtCommented:
0
mcrmgAuthor Commented:
thanks for the quick reply. Please see the before and after comparison. Some values are odd and off. thanks
Book1.xlsx
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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
0
Martin LissOlder than dirtCommented:
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

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mcrmgAuthor 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
0
mcrmgAuthor Commented:
thank you very much
0
Martin LissOlder than dirtCommented:
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.
0
mcrmgAuthor Commented:
The code you helped me works execllent..thank you
0
Martin LissOlder than dirtCommented:
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)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.