Link to home
Start Free TrialLog in
Avatar of mcrmg
mcrmg

asked on

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

Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Did you try my code from that thread?
Avatar of mcrmg
mcrmg

ASKER

forgot the file. sorry
Book1.xlsx
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

Avatar of mcrmg

ASKER

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

ASKER

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


thanks
Avatar of mcrmg

ASKER

thanks for the quick reply. Please see the before and after comparison. Some values are odd and off. thanks
Book1.xlsx
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
ASKER CERTIFIED SOLUTION
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of mcrmg

ASKER

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
Avatar of mcrmg

ASKER

thank you very much
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.
Avatar of mcrmg

ASKER

The code you helped me works execllent..thank you
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)