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

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

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,130,112
Messages
5,640,173
Members
417,129
Latest member
geekzilla

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