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 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).

I think I may see the issue. Note that the line in green is under the "With ws_rmr1" block. So it is formatted column A on this rmr1 sheet, not your THOLD sheet.
I see the rmr1 sheet formatted like "dd/mmm/yyyy" and the THOLD sheet formatted like "m-ddd-yy".

 

[Ark68]

Joe, I so appreciate the effort you're putting into helping me. I really do appreciate it and hope I don't wear out my welcome.

I obviously don't know my own code. I'm not seeing where I'm formatting the date values in THOLD as m-ddd-yy. This is the data in THOLD that my code generates.

WSOP 23_v23.04.24 .xlsm
	A	B
1	08-Jul-23	Saturday 08-Jul
2	09-Jul-23	Sunday 09-Jul
3	10-Jul-23	Monday 10-Jul
4	11-Jul-23	Tuesday 11-Jul
THOLD

I think I have a logic issue with the two green lines. I'll rewrite, test and report back.

 

[Joe4]

Let's go back to the very beginning, your original question, where at the end you said this:

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).

Which sheet are you looking at/referring to when you make this statement?

 

[Ark68]

The dd/mmm/yyyy format of the date is intended for column(1) of worksheet ("sheet1") in workbook "rmr1", which is the basis of the list created in THOLD. They should be the same format in the final product.

I rewrote my code hoping it would make a difference. If I may share ...

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 = DateValue(.Cells(std, 1))
Stop 'stop 1
                .Cells(std, 1) = 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 'date
                    ws_thold.Cells(drow, 2) = Format(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
Stop 'stop2
    ws_rmr1.Columns("A:A").NumberFormat = "dd/mmm/yyyy"
    ws_thold.Columns("A:A").NumberFormat = "dd/mmm/yyyy"
    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

Here is the sample of the original data in RMR1 with the text date. For consistency, I won't change the data references.

RMR1.xlsx
	A	B	C	D
1	Date	Day	Setup - Ready Time	Start - End Time
2	Jul 10, 2023	Monday		04:30 PM - 08:15 PM
3	Jul 10, 2023	Monday		05:00 PM - 06:00 PM
4	Jul 10, 2023	Monday		06:00 PM - 07:30 PM
Sheet1

After stop1, the value for vl = "2023-07-10"

After stop2, the original date data in column 1 of rmr1 looks like:

RMR1.xlsx
	A	B	C	D
1	Date	Day	Setup - Ready Time	Start - End Time
2	2023-07-10	Monday		04:30 PM - 08:15 PM
3	2023-07-10	Monday		05:00 PM - 06:00 PM
4	2023-07-10	Monday		06:00 PM - 07:30 PM
5	2023-07-10	Monday		06:00 PM - 09:00 PM
Sheet1

and the data in THOLD looks like:

WSOP 23_v23.04.24 .xlsm
	A	B
1	2023-07-10	Monday 10-Jul
2
3
THOLD

After stop3, , the original date data in column 1 of rmr1 looks like:

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
Sheet1

and the data in THOLD looks like:

WSOP 23_v23.04.24 .xlsm
	A	B	C
1	08-Jul-2023	Saturday 08-Jul	54
2	09-Jul-2023	Sunday 09-Jul	56
3	10-Jul-2023	Monday 10-Jul	73
4	11-Jul-2023	Tuesday 11-Jul	75
THOLD

Note that I only used the top 4 records of the 258 records in rmr1 that span 4 dates.

Not sure if this helps, or hinders progress. All I know is I made it quite clear that column 1 in both workbook RMR1 (Sheet1) and WSOP(THOLD) were formatted as "dd/mmm/yyy" and I'm getting "dd-mmm-yyyy"

I don't want to spend a lot of time on this, as the dates are correct. That really is all that matters. Where I fear it may become a problem is in this code below where I have to rely on auto filtering of said dates.

From my userform (uf_dateselect) form:

Private Sub uf_proceed_Click()
    Dim cnt As Long
    Dim selectedRows As Collection
    Dim t
    Dim c As Range, sh As Worksheet
    Dim i As Long
    Dim mydate
    Dim tb_name As String
    
    cnt = lbx_datesel.ListCount
    If cnt = 1 Then
        t = lbx_datesel.ListIndex
        mydate = CDate(lbx_datesel.List(t))
        MsgBox Format(mydate, "dd-mmm-yyyy") '######
        tb_name = "Core_Data_" & Format(mydate, "dd-mmm")
        wb_rmr1.Worksheets("Sheet1").Copy after:=wb_wsop.Sheets(Sheets.Count)
        ActiveSheet.Name = tb_name
    Else 'allows user to process more than one date
        'https://www.mrexcel.com/board/threads/struggling-with-multiselect-userform-listboxes.1235796/
        With lbx_datesel
            For i = 0 To cnt - 1
                If .Selected(i) = True Then
                    mydate = format(.List(i),"dd)
                    ws_rmr1.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, Format(mydate, "mm/dd/yyyy"))
                    Sheets.Add(, Sheets(Sheets.Count)).Name = "Core_Data_" & Format(mydate, "dd-mmm")
                    ws_rmr1.AutoFilter.Range.EntireRow.Copy Range("A1")
                End If
            Next i
        End With
        ws_rmr1.Select
        ws_rmr1.ShowAllData
    End If
End Sub

 

[Alex Blakenburg]

Using your code in post #14, try this:

Move your 2 number formatting lines that are after the end of the For-Next Loop to before the For statement.
The reason for doing this is that if the column happens to be formatted as "Text" before you start writing dates to it there is a chance that it won't behave as expected.

   ' XXX currently the next 2 lines are after the Next statement
    ws_rmr1.Columns("A:A").NumberFormat = "dd/mmm/yyyy"     ' XXX you could drop the ws_rmr1 since it is inside the with statement
    ws_thold.Columns("A:A").NumberFormat = "dd/mmm/yyyy"
            For std = 2 To cntrmr1raw + 1

Get rid of the number formatting line inside the loop, there is no point in doing it in each iteration since you are formatting the whole column.

'Stop 'stop 1
                .Cells(std, 1) = vl
                .Columns("A:A").NumberFormat = "dd/mmm/yyyy"

Change your data type for vl it is currently a string change it to date.
(this is not the case for your post #1 code, since it does the date conversion in a different order)

    Dim vl As String 'looped date value from raw rmr1
    Dim vl As Date 'looped date value from raw rmr1

 

[Ark68]

Hi Alex, thank you for sharing your insight. Both you and Joe had been very helpful and everything suggested makes total sense. But I still am unable to get it to work.
I have shared my files if either would like to see if it "works" for you to help isolate if it's juyst a problem at my end.

As mentioned, the dates are correct, the formatting is irrelevant. I'm just afraid of how it will lead to problems with my userform routine I posted at the end of post #14. If we want to accept that the orginal problem has no solution, perhaps have a peak at my code for the userform and give me a hint as to whether I can anticipate problems autofilering my data in RMR1 by date. That code is messed up and doesn't work now, but I didn't want to play around too much with it and post questions if the proiblem isn't with it but rather the data.

Core File (holds code)
Data FIle (RMR1)

BTW, I'm using Microsoft 365

 

[Alex Blakenburg]

Your clean_rmrl works fine for me. My default date format is dd/mm/yyyy (I think yours is the same)

The only changes I make to you clean code to run it are to point it to the current workbook by adding the following:
(and commenting out the last "uf_dateselect.Show" line)

    ' XXXX Added for testing
    Dim ws_rmr1 As Worksheet, ws_thold As Worksheet
    Dim uf_caption As String, lb_msg1 As String
    Set ws_rmr1 = Worksheets("Sheet1")
    Set ws_thold = Worksheets("THOLD")
    ' XXXX

I avoid using Public variables so it might be worth throwing in the debug line below just to make sure it is pointing to the right place.

Debug.Print ws_rmr1.Range("A1").Address(external:=True)

The output your clean sub produced for me is:

 

[Alex Blakenburg]

Where I fear it may become a problem is in this code below where I have to rely on auto filtering of said dates.

Addressing this, as long as both filter data and the filter criteria are being recognised as dates which you are indicating is the case your main filter line is fine but the preceding line is not.
You have mydate as variant unless it causes other issues date might be safer,

                    mydate = format(.List(i),"dd") ' Get rid of this (it was actually missing the trailing quote)
                    ws_rmr1.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, Format(mydate, "mm/dd/yyyy"))

 

[Ark68]

Thanks Alex. The debug action suggestion nets the correct address. I've set wb_rmr1 and ws_rmr1 in a variety of different places and tested in the immediate window and all resulted with the proper name.
I suppose we'll settle as it being life's little mystery. This behaviour is the same between my home and school computers, but not yours.

So, I've moved on, and as feared, I'm having issues with the autofilter. (this is now morphed into a cross post to this MrExcel Post)

Private Sub uf_proceed_Click()
    Dim cnt As Long
    Dim selectedRows As Collection
    Dim t
    Dim c As Range, sh As Worksheet
    Dim i As Long
    Dim mydate As Date
    Dim tb_name As String
  
    cnt = lbx_datesel.ListCount
    If cnt = 1 Then
        t = lbx_datesel.ListIndex
        mydate = CDate(lbx_datesel.List(t))
        MsgBox Format(mydate, "dd-mmm-yyyy") '######
        tb_name = "Core_Data_" & Format(mydate, "dd-mmm")
        wb_rmr1.Worksheets("Sheet1").Copy after:=wb_wsop.Sheets(Sheets.Count)
        ActiveSheet.Name = tb_name
    Else 'allows user to process more than one date
        'https://www.mrexcel.com/board/threads/struggling-with-multiselect-userform-listboxes.1235796/
        With lbx_datesel
Stop
            For i = 0 To cnt - 1
                If .Selected(i) = True Then
                    ws_rmr1.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, Format(mydate, "mm/dd/yyyy"))
                   [COLOR=rgb(0, 0, 0)] Sheets.Add(, Sheets(Sheets.Count)).Name = "Core_Data_" & Format(mydate, "dd-mmm")[/COLOR]
                    ws_rmr1.AutoFilter.Range.EntireRow.Copy Range("A1")
                End If
            Next i
        End With
        ws_rmr1.Select
        ws_rmr1.ShowAllData
    End If
End Sub

I'm not getting an error, but I'm not getting the results. The worksheet that is corrected is named "Core_Data_30_Dec"), it contains no data other than the header text from the source data (ws_rmr1). The filtered data shows no visible rows, other than the header.

 

[Ark68]

So even having eliminated this code, I still struggle with proper date formatting.

Sample data after code is executed:
[

WSOP 23_v23.04.24 .xlsm
	A	B	C	D
1	Date	Day	Start	End
2	2023-07-08	Saturday	2023-07-08 8:30	2023-07-08 15:00
3	2023-07-08	Saturday	2023-07-08 8:30	2023-07-08 15:00
4	2023-07-08	Saturday	2023-07-08 8:30	2023-07-08 15:00
5	2023-07-08	Saturday	2023-07-08 8:00	2023-07-08 23:00
6	2023-07-08	Saturday	2023-07-08 9:00	2023-07-08 17:00
7	2023-07-08	Saturday	2023-07-08 9:00	2023-07-08 17:00
8	2023-07-08	Saturday	2023-07-08 9:00	2023-07-08 16:00
9	2023-07-08	Saturday	2023-07-08 9:00	2023-07-08 16:00
CoreData_08-Jul

The code that got us here ...

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
    Dim I As Long, L1 As Long
    Dim xCount As Integer
    Dim ws_t As Worksheet 'target worksheet for cleaning
    Dim nrec As Integer 'number of records in ws_t
    Dim s_start As String, s_end As String
    Dim i_start As Double, i_end As Double 'start and end time values
    Dim i_sdate As Double, i_edate As Double 'start and end date values
    Dim i_sdttm As Double, i_edttm As Double 'start end end date/time
    
    Set ws_rmr1 = wb_rmr1.Worksheets("Sheet1")
    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
            '.Columns("A:A").NumberFormat = "dd/mmm/yyyy"
            'ws_thold.Columns("A:A").NumberFormat = "dd/mmm/yyyy"
            For std = 2 To cntrmr1raw + 1
                'vl = DateValue(.Cells(std, 1))
                vl = .Cells(std, 1)
                '.Cells(std, 1) = vl
                If Application.WorksheetFunction.CountIf(ws_thold.Columns(1), vl) < 1 Then 'add to the list
                    ws_thold.Cells(drow, 1) = .Cells(std, 1) 'text date
                    ws_thold.Cells(drow, 2) = Format(vl, "dddd  dd-mmm") 'format for listbox
                    ws_thold.Cells(drow, 4) = Format(DateValue(ws_thold.Cells(drow, 1)), "dd-mmm-yyyy")
                    drow = drow + 1 'advance destination row for next unique date value
                End If
            Next std
        End If
    End With
'Stop
    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
    
    For I = 1 To ActiveWorkbook.Sheets.Count
        If Left(Sheets(I).Name, 8) = "CoreData" Then
            emsg = "Cleaning: " & Sheets(I).Name
            Set ws_t = Worksheets(Sheets(I).Name)
            With ws_t
                nrec = .Range("A" & .Rows.Count).End(xlUp).Row - 1
                .Rows("1:" & nrec).RowHeight = 12.75
                .Columns("A:Z").AutoFit
              ' Column A - Dates
                emsg = "Cleaning: " & Sheets(I).Name & " - Date formatting"
                For L1 = 2 To nrec
                    .Cells(L1, 1).Value = DateValue(.Cells(L1, 1))
                Next L1
              'Columns C, J, K, L, P, Q, R, S, T, W - Delete redundant
              emsg = "Cleaning: " & Sheets(I).Name & " - Redundant columns"
              .Columns("A:O").AutoFit
              .Range("C:C, J:L, P:T, W:W").EntireColumn.Delete
              'column C - Times
              emsg = "Cleaning: " & Sheets(I).Name & " - Formatting Times"
              .Range("D:E").EntireColumn.Insert
Stop
              For L1 = 2 To nrec
                s_start = Left(.Cells(L1, 3), 8)
                s_end = Right(.Cells(L1, 3), 8)
                i_start = TimeValue(s_start)
                i_end = TimeValue(s_end)
                i_sdate = .Cells(L1, 1)
                If i_end < i_start Then 'next day
                    i_edate = i_edate + 1
                Else
                    i_edate = .Cells(L1, 1)
                End If
                i_sdttm = i_sdate + i_start 'xxxxx.xxxxxx
                i_edttm = i_edate + i_end
                .Cells(L1, 4) = Format(i_sdttm, "dd-mmm-yy h:mm am/pm")
                .Cells(L1, 5) = Format(i_edttm, "dd-mmm-yy h:mm am/pm")
                .Columns("D:E").AutoFit
              Next L1
              .Columns(3).Delete
              .Cells(1, 3) = "Start"
              .Cells(1, 4) = "End"
            End With
            Stop
        End If
    Next I
End Sub

The lines in green assign the format to the value of the date and time combined. If I manually change the date+time values in columns C & D to a number, I get a number (eg cell C2 returns a number of 45115.35417). If I manually assign a custom format of "dd-mmm-yy h:mm am/pm", the example using cell C2 returns 08-Jul-23 8:30 AM. I noticed when I went to customize the date through the format dialogue, that the custom selection had the default format for cell C2 as "YYYY-MM-DD h:mm". That likely explains why the values in my worksheet are formatted the way they are. But how did those cells get that custom format, contrary to the format I applied in the code? I thought perhaps the source data (RMR1.xlsx) were formatted, but all the columns are showing as being "General".

This is going to be a critical problem as I need my dates to be able to take on the proper formats. Original;ly it was just an inconvenience because I was of the belief I'd be able to make the proper format adjustments with my working database (the worksheets created).

Thoughts?