Can Acquire the Proper Date Format

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,562
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have this code ....
Rich (BB code):
With ws_rmr1
        cntrmr1raw = .Range("A" & .Rows.Count).End(xlUp).Row - 1
        If cntrmr1raw < 1 Then
            uf_caption = "RMR1 EMPTY"
            lb_msg1 = "rmr1.xlsx is empty of any records." & Chr(13) & "Access ActiveNet to recreate the file or [NOT NOW] to cancel."
        Else
            'create unique date list
            ws_thold.Columns("A:D").Clear
            drow = 1
            For std = 2 To cntrmr1raw + 1
                vl = .Cells(std, 1)
                .Cells(std, 1) = DateValue(vl)
                .Columns("A:A").NumberFormat = "dd/mmm/yyyy"
                If Application.WorksheetFunction.CountIf(ws_thold.Columns(1), vl) < 1 Then 'add to the list
                    ws_thold.Cells(drow, 1) = vl 'text date
                    ws_thold.Cells(drow, 2) = Format(DateValue(vl), "dddd  dd-mmm") 'true date conversion
                    drow = drow + 1 'advance destination row for next unique date value
                End If
            Next std
        End If
    End With

In the std loop, i get the value of variable 'vl' from my data source. It is gathered from column 1 in each of the rows of the loop ('std')
The values in column 1 of the source worksheet (ws-rmr1) are text representations of dates, and take on this format "Jul 10, 2023"
The line in green converts that text date to a true date.
The following green line is supposed to give the dates a format of dd/mmm/yyyy. But it's not. Why is my result 10-07-2023? The date is correct, just the the format I expected (10/Jul/2023).
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
The values in column 1 of the source worksheet (ws-rmr1) are text representations of dates, and take on this format "Jul 10, 2023"
The line in green converts that text date to a true date.
The FORMAT function in VBA (and similar TEXT function in Excel worksheet functions) ONLY work on values that are valid date/number entries!
The do NOT affect Text entries!

So you would first need to convert the value in the cell to a valid date entry before you can apply the FORMAT function to it.
Take a look at the VBA CDATE function: MS Excel: How to use the CDATE Function (VBA)
 
Upvote 0
The FORMAT function in VBA (and similar TEXT function in Excel worksheet functions) ONLY work on values that are valid date/number entries!
The do NOT affect Text entries!

So you would first need to convert the value in the cell to a valid date entry before you can apply the FORMAT function to it.
Thanks Joe. But didn't I convert the text date in column A:A to a true date value with:
Code:
.Cells(std, 1) = DateValue(vl)
?
 
Upvote 0
I missed that originally, and yes, it should, provided you are actually hitting that part of the code and looking at the correct cells.

I think we really need to see more details, such as what your data looks like, the full procedure code, and letting us know exactly how this code is being invoked.
Once we have all of that, we can try to recreate it here on our side and step through it to see what is going on.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.
 
Upvote 0
Thanks Joe.

Here is a sample of the raw data from workbook "rmr1", worksheet ("Sheet1")
RMR1.xlsx
ABCD
1DateDaySetup - Ready TimeStart - End Time
2Jul 10, 2023Monday08:30 AM - 04:30 PM
3Jul 10, 2023Monday05:30 PM - 08:30 PM
4Jul 10, 2023Monday05:30 PM - 08:30 PM
5Jul 10, 2023Monday05:30 PM - 08:30 PM
6Jul 10, 2023Monday05:00 PM - 08:30 PM
7Jul 10, 2023Monday06:30 PM - 11:00 PM
8Jul 10, 2023Monday06:00 PM - 09:00 PM
9Jul 10, 2023Monday09:00 PM - 11:00 PM
10Jul 10, 2023Monday06:30 PM - 08:00 PM
11Jul 10, 2023Monday06:30 PM - 08:00 PM
12Jul 10, 2023Monday06:30 PM - 08:00 PM
13Jul 10, 2023Monday06:30 PM - 08:00 PM
14Jul 10, 2023Monday06:30 PM - 11:00 PM
Sheet1


From a button on my working workbook's worksheet (ws_front). The code resides in this workbook.
VBA Code:
Sub RoundedRectangle1_Click()
    'start button
    Initialize
    import_rmr1
    clean_rmrl
    'import_pefb1
    'clean_pefb1
    'compile_core_data
End Sub

VBA Code:
Public ws_front As Worksheet
Public ws_thold As Worksheet
Public wb_rmr1 As Workbook
Public ws_rmr1 As Worksheet
Public wb_pebf2 As Workbook
Public ws_pebf2 As Worksheet
Public wb_permitdata As Workbook

Public lb_msg1 As String
Public uf_caption As String

Public Sub Initialize()
    apppath = "D:/WSOP 2023/"
    suppath = apppath & "SupportData/"
    anpath = apppath & "ActiveNet/"
    datapath = apppath & "Data/"
    distpath = apppath & "Distributables/"
    permpath = apppath & "Permits/"
    Set wb_wsop = Workbooks(ThisWorkbook.Name)
    Set ws_front = wb_wsop.Worksheets("FRONT")
    Set ws_thold = wb_wsop.Worksheets("THOLD")
End Sub

VBA Code:
Sub import_rmr1()
    'accesses raw rmr1 file and imports data to workbook
    'error check - does file exist?
    Dim st_ftq As String
    st_ftq = anpath & "rmr1.xlsx"
    'fn_FileExists (st_ftq)
    If fn_FileExists(st_ftq) = False Then
        lb_msg1 = "The ActiveNet created file (RMR1) is missing. Please access ActiveNet and run report: 'Rob K - All Parks Areas (including diamonds and fields) - with Notes' to create the file. " & _
            "Ensure the file is placed in the WSOP 2023 ActiveNet folder."
        uf_caption = "Critical File Missing: RMR1"
        uf_activenet.show
    Else
        With ws_front
            .Range("E3") = "Opening RMR1"
            'fn_openhide (st_ftq)
            fn_IsFileOpen (st_ftq)
            .Range("E2") = .Range("E3")
            .Range("E3") = "RMR1 open [HIDDEN]"
        End With
    End If
End Sub
Sub clean_rmrl()
    Dim cntrmr1raw As Double
    Dim drow As Long 'destination row for date list
    Dim std As Long 'rows of raw rmr1
    Dim vl As String 'looped date value from raw rmr1
    
    With ws_rmr1
        cntrmr1raw = .Range("A" & .Rows.Count).End(xlUp).Row - 1
        If cntrmr1raw < 1 Then
            uf_caption = "RMR1 EMPTY"
            lb_msg1 = "rmr1.xlsx is empty of any records." & Chr(13) & "Access ActiveNet to recreate the file or [NOT NOW] to cancel."
        Else
            'create unique date list
            
            ws_thold.Columns("A:D").Clear
            drow = 1
            For std = 2 To cntrmr1raw + 1
                vl = .Cells(std, 1)
                .Cells(std, 1) = DateValue(vl)
                .Columns("A:A").NumberFormat = "dd/mmm/yyyy"
                If Application.WorksheetFunction.CountIf(ws_thold.Columns(1), vl) < 1 Then 'add to the list
                    ws_thold.Cells(drow, 1) = vl 'text date
                    ws_thold.Cells(drow, 2) = Format(DateValue(vl), "dddd  dd-mmm") 'true date conversion
                    drow = drow + 1 'advance destination row for next unique date value
                End If
            Next std
        End If
    End With

    drow = 1
    With ws_thold
        Do Until .Cells(drow, 1) = ""
            .Cells(drow, 3) = Application.WorksheetFunction.CountIf(ws_rmr1.Columns(1), .Cells(drow, 1))
            drow = drow + 1
        Loop
    End With
    
    'present user with list of dates to select from
    uf_dateselect.show
End Sub

Hope this helps.
 
Upvote 0
So the code you are having issues with is the "clean_rmrl" procedure, right?
The data image you posted, is that what the data looks like after you run the "import_rmr1" procedure on it?
I want to to run the "clean_rmrl" procedure on the data, exactly as you have it at that point in time.
 
Upvote 0
Hi Joe, yes, "clean_rml1". RMR1.xlsx sheet1 which holds the raw data get it's formatting changed at various spots to make it usable for Excel (the rmr1 file is actually all text as exported by another application)
The data you see is the original data before the code has been utilized.
This is the same data after the code is executed... (different dates because I ran a different report for July 8th. )
RMR1.xlsx
ABCD
1DateDaySetup - Ready TimeStart - End Time
208-Jul-2023Saturday08:30 AM - 03:00 PM
308-Jul-2023Saturday08:30 AM - 03:00 PM
408-Jul-2023Saturday08:30 AM - 03:00 PM
508-Jul-2023Saturday08:00 AM - 11:00 PM
608-Jul-2023Saturday09:00 AM - 05:00 PM
708-Jul-2023Saturday09:00 AM - 05:00 PM
808-Jul-2023Saturday09:00 AM - 04:00 PM
908-Jul-2023Saturday09:00 AM - 04:00 PM
1008-Jul-2023Saturday01:00 PM - 04:00 PM
1108-Jul-2023Saturday01:00 PM - 04:00 PM
1208-Jul-2023Saturday09:30 AM - 04:30 PM
1308-Jul-2023Saturday08:00 AM - 08:00 PM
1408-Jul-2023Saturday08:00 AM - 08:00 PM
Sheet1
 
Upvote 0
OK, one last question to help me determine the exact format of the data in column A, can you enter this formula into any blank cell on the sheet and tell me what it returns?
Excel Formula:
=ISNUMBER(A2)
 
Upvote 0
Before code = FALSE
After code = TRUE
 
Upvote 0
Before code = FALSE
After code = TRUE
Before/after which procedure, exactly?

Basically, I need to know what it looks like after the "import_rmr1" procedure runs but before the "clean_rmrl" procedure" runs.
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,034
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top