Format cell to delete a portion of a cell text

[gingerbreadgrl]

Hi,

I am using a software program to export my data into excel, then using a macro to organize the data. Unfortunately, the software program only has the option to have both date AND time exported so the cells containing that data look like the following:

8/29/2019 4:00 PM

This occurs in just one column in the entire spreadsheet. Is there a way to format the cells in that column so that the time can be deleted and the date would be the only data left in the cell?

I anticipate having maybe 10 rows of data in that column so if it would be easier to just format the cell instead I could just copy and paste the code and change it for each cell too.

Thanks,
Gingerbreadgrl

 

[Rick Rothstein]

Rick, I put the sheet name in the code as the following:

Sheets("Clt Info").Columns("D").Replace " *", "", xlPart, , , , False, False

When I did that the date and time changed in the column to the following:

8/23/2019 0:00 is visible within the cell, when you click on the cell it shows 8/23/2019 12:00 AM

It is just a a display thing. Select the cells in Column D with dates and change the cell format to the date display format you want. We can also do it in the code. See if this works for you...

Sub Format_Date()
  Columns("D").Replace " *", "", xlPart, , , , False, False
  Columns("D").SpecialCells(xlConstants).NumberFormat = "m/d/yyyy"
End Sub

 

[mohadin]

Try

Sub dateonly()
        Dim sm As Object, a
    r = Cells(Rows.Count, "d").End(xlUp).Row
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "^([1-9]|1[0-2])[\/](0?[1-9]|[12]\d|3[01])[\/](19|20)\d{2}"
        a = Application.Transpose(Range("d1:d" & r))
        For i = 1 To r
            Set m = .Execute(a(i))
            a(i) = m(0).Value
        Next
    End With
    a = Application.Transpose(a)
    [d1].Resize(UBound(a)) = a '> you may change
End Sub

 

[DanteAmor]

DanteAmor,

I wanted to try your code but because I was unable to designate the "Clt Info" sheet it produced an error, would you be able designate the "Clt Info" sheet within your code so I could try that out too?

Thanks so much to the both of you for your time and effort!!

It is not necessary to establish the sheet, just run the code on the sheet, that would have worked for you. But here you have it.

Sub Format_Date()
  Dim c As Range, y, m, d
  For Each c In sheets("Clt Info").Range("D2",  sheets("Clt Info").Range("D" & Rows.Count).End(xlUp))
    y = Mid(c, InStr(4, c, "/") + 1, 4)
    m = Left(c, InStr(1, c, "/") - 1)
    d = Replace(Mid(c, InStr(1, c, "/") + 1, 2), "/", "")
    c.Value = DateSerial(y, m, d)
  Next
End Sub

 

[gingerbreadgrl]

Hi All,

Thanks so much for all of your help!! I wanted to make sure that I posted a clear resolution for the next newbie who may be wanting to solve this issue. I also wanted to provide a little more background on what I wanted to accomplish to help any future user of this code. As this excel spreadsheet is really just a pass through to organize data from the system exporting it to the system importing it I really am not "working" in this spreadsheet. Therefore, it is helpful to have the sheet declared (as the data organizes into multiple sheets) so that I do not need to navigate to the sheet or click on anything beyond running the macro. Therefore, I am putting "Sheet Name" in as a placeholder for anyone who wants to do the same, however, if you do not need this, it can be deleted (please reference the code in the previous posts for an example of what this should look like).

DanteAmor, your code worked beautifully when I combined it with the last line "Sheets("Sheet Name").Range("D:D").NumberFormat = "m/d/yyyy" for reference here is the entire code:

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Dim c As Range, y, m, d
For Each c In Sheets("Sheet Name").Range("D2", Sheets("Sheet Name").Range("D" & Rows.Count).End(xlUp))
y = Mid(c, InStr(4, c, "/") + 1, 4)
m = Left(c, InStr(1, c, "/") - 1)
d = Replace(Mid(c, InStr(1, c, "/") + 1, 2), "/", "")
c.Value = DateSerial(y, m, d)
Next[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sheets("Sheet Name").Range("D:D").NumberFormat = "m/d/yyyy"[/FONT]

Rick, the code you suggested worked beautifully as well, for reference here is the code with the sheet declared:

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sheets("Sheet Name").Columns("D").Replace " *", "", xlPart, , , , False, False
Sheets("Sheet Name").Columns("D").SpecialCells(xlConstants).NumberFormat = "m/d/yyyy"[/FONT]

Mohadin, the code you suggested below produced a type mismatch error, but perhaps this is because there were multiple worksheets and it was not declared in the code:

Sub DateOnly ()
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Dim sm As Object, a
    r = Cells(Rows.Count, "d").End(xlUp).Row
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "^([1-9]|1[0-2])[\/](0?[1-9]|[12]\d|3[01])[\/](19|20)\d{2}"
        a = Application.Transpose(Range("d1:d" & r))
        For i = 1 To r
            Set m = .Execute(a(i))
            a(i) = m(0).Value
        Next
    End With
    a = Application.Transpose(a)
    [d1].Resize(UBound(a)) = a '> you may change[/FONT]
End Sub

Thank you all so much for your expertise!!

Best,
Gingerbreadgrl

 

[mohadin]

Mohadin, the code you suggested below produced a type mismatch error, but perhaps this is because there were multiple worksheets and it was not declared in the code:

Well
If Option Explicit you are right
Thank you for feedback

 

[DanteAmor]

DanteAmor, your code worked beautifully when I combined it with the last line "Sheets("Sheet Name").Range("D:D").NumberFormat = "m/d/yyyy"
Gingerbreadgrl

I'm glad to help you. Thanks for the feedback.