always_confused
Board Regular
- Joined
- Feb 19, 2021
- Messages
- 68
- Office Version
- 2016
- Platform
- Windows
Hello,
I am trying to fill a column with distinct date values with different formats depending on the sheet (sometimes dd-mm-yyyy, sometimes mm-yyyy). I have made a Sub which fills Dictionary with distinct values in the correct format, and then copies them to the sheet. However, no all of the values come out in the correct order (mm-dd-yyyy instead of dd-mm-yy). For values in December and January, I get a column like:
12/10/2020 'these are good
12/11/2020
14/12/2020
15/12/2020
..... 'all dd/mm/yyyy format
31/12/2020
01/04/2020 'back to mm/dd/yyy
01/06/2020
....
13/01/2021
Here is my Sub:
I am trying to fill a column with distinct date values with different formats depending on the sheet (sometimes dd-mm-yyyy, sometimes mm-yyyy). I have made a Sub which fills Dictionary with distinct values in the correct format, and then copies them to the sheet. However, no all of the values come out in the correct order (mm-dd-yyyy instead of dd-mm-yy). For values in December and January, I get a column like:
12/10/2020 'these are good
12/11/2020
14/12/2020
15/12/2020
..... 'all dd/mm/yyyy format
31/12/2020
01/04/2020 'back to mm/dd/yyy
01/06/2020
....
13/01/2021
Here is my Sub:
VBA Code:
Sub get_unique_time(name As String, copy_to As String, place_instring As Integer, _
string_length As Integer, format As String)
Dim pos As Range
Dim vStr, eStr
Dim dObj As Object
Dim xRg As Range
Dim rng As Range
Dim lastrow As Long
lastrow = Sheets("Source_Sheet").Range("B" & Rows.Count).End(xlUp).Row
Set rng = Sheets("Source_Sheet").Range("B2:B" & lastrow) 'column containing timestamp values format dd-mm-yyyy hh-mm
With Range(copy_to & ":" & copy_to)
.Clear
.NumberFormat = format 'should set destination column to correct format
End With
On Error Resume Next
Set dObj = CreateObject("Scripting.Dictionary")
Set xRg = rng
vStr = xRg.Value
With dObj
.comparemode = 1
For Each eStr In vStr
If Not .exists(Mid(eStr, place_instring, string_length)) And eStr <> "" _ 'gets the proper section of timestamp
Then .Add Mid(eStr, place_instring, string_length), Nothing
Next
Dim i As Long
For i = 0 To dObj.Count - 1
Sheets(name).Range(copy_to & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 'copies to sheet name
dObj.Keys()(i)
Next i
End With
End Sub