Filling column with Dictionary Keys

always_confused

Board Regular
Joined
Feb 19, 2021
Messages
66
Office Version
  1. 2016
Platform
  1. 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:

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
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

StephenCrump

MrExcel MVP
Joined
Sep 18, 2013
Messages
4,124
Office Version
  1. 365
Platform
  1. Windows
Does it work with:

Sheets(name).Range(copy_to & Rows.Count).End(xlUp).Offset(1, 0).Value = DateValue(dObj.keys()(i))
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,129,593
Messages
5,637,294
Members
416,963
Latest member
zazama

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
Top