Can Acquire the Proper Date Format

[Ark68]

I have this 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).

 

[Joe4]

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)

 

[Ark68]

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:

.Cells(std, 1) = DateValue(vl)

?

 

[Joe4]

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.

 

[Ark68]

Thanks Joe.

Here is a sample of the raw data from workbook "rmr1", worksheet ("Sheet1")

RMR1.xlsx
	A	B	C	D
1	Date	Day	Setup - Ready Time	Start - End Time
2	Jul 10, 2023	Monday		08:30 AM - 04:30 PM
3	Jul 10, 2023	Monday		05:30 PM - 08:30 PM
4	Jul 10, 2023	Monday		05:30 PM - 08:30 PM
5	Jul 10, 2023	Monday		05:30 PM - 08:30 PM
6	Jul 10, 2023	Monday		05:00 PM - 08:30 PM
7	Jul 10, 2023	Monday		06:30 PM - 11:00 PM
8	Jul 10, 2023	Monday		06:00 PM - 09:00 PM
9	Jul 10, 2023	Monday		09:00 PM - 11:00 PM
10	Jul 10, 2023	Monday		06:30 PM - 08:00 PM
11	Jul 10, 2023	Monday		06:30 PM - 08:00 PM
12	Jul 10, 2023	Monday		06:30 PM - 08:00 PM
13	Jul 10, 2023	Monday		06:30 PM - 08:00 PM
14	Jul 10, 2023	Monday		06:30 PM - 11:00 PM
Sheet1

From a button on my working workbook's worksheet (ws_front). The code resides in this workbook.

Sub RoundedRectangle1_Click()
    'start button
    Initialize
    import_rmr1
    clean_rmrl
    'import_pefb1
    'clean_pefb1
    'compile_core_data
End Sub

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

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.

 

[Joe4]

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.

 

[Ark68]

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
	A	B	C	D
1	Date	Day	Setup - Ready Time	Start - End Time
2	08-Jul-2023	Saturday		08:30 AM - 03:00 PM
3	08-Jul-2023	Saturday		08:30 AM - 03:00 PM
4	08-Jul-2023	Saturday		08:30 AM - 03:00 PM
5	08-Jul-2023	Saturday		08:00 AM - 11:00 PM
6	08-Jul-2023	Saturday		09:00 AM - 05:00 PM
7	08-Jul-2023	Saturday		09:00 AM - 05:00 PM
8	08-Jul-2023	Saturday		09:00 AM - 04:00 PM
9	08-Jul-2023	Saturday		09:00 AM - 04:00 PM
10	08-Jul-2023	Saturday		01:00 PM - 04:00 PM
11	08-Jul-2023	Saturday		01:00 PM - 04:00 PM
12	08-Jul-2023	Saturday		09:30 AM - 04:30 PM
13	08-Jul-2023	Saturday		08:00 AM - 08:00 PM
14	08-Jul-2023	Saturday		08:00 AM - 08:00 PM
Sheet1

 

[Joe4]

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?

=ISNUMBER(A2)

 

[Ark68]

Before code = FALSE
After code = TRUE

 

[Joe4]

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.