Loop to create Object

[saputroa272]

Hi again

I tried to get the unique value of each column in the range "RD" and displays them in single column so I need to create an object ("scripting.Dictionary") are just as much the number of columns in Range "RD". I tried this code but result in "Run time error 91"

Private Sub CommandButton1_Click()
Range(Me.RefEdit1).Name = "RD"
Range(Me.RefEdit2).Name = "OT"
Dim d As Object, c As Variant, i As Long, s As Long
Dim JK As Long
Dim o As Collection
JK = Range("RD").Columns.Count
d = CreateObject("Scripting.Dictionary")
For k = 0 To JK + 1
c = Range("RD").Columns(k + 1)
Set o = New Collection
o.Name = "Name is " & k
d.Add k, o
For i = 1 To UBound(c, 1)
  o(c(i, 1)) = 1
Next i
Range("OT").Cells((k * 5) + 2, 2).Resize(d.Count) = Application.Transpose(d.Keys)
Range("OT").Cells((k * 5) + 2, 2).Resize(d.Count).Sort Key1:=Range("OT").Cells((k * 5) + 2, 2).Resize(d.Count)
Next k
End Sub

loop_to.xlsm
any help will be appreciated

[Marc L]

Sub Demo()
    [OT].CurrentRegion.Clear
    Application.ScreenUpdating = False

    With CreateObject("Scripting.Dictionary")
        For Each V In [RD].Value:  .Item(V) = "":  Next
        [OT].Resize(.Count).Value = Application.Transpose(.Keys)
        .RemoveAll
    End With
    
    [OT].CurrentRegion.Sort [OT]
End Sub 

Do you like it ? So thanks to click on bottom left star icon « Add Reputation » !

[saputroa272]

Hi, marc L
many thank for the reply
your code worked fine but it just create a single "Scripting.Dictionary" so it produce unique values of whole columns instead of each one.
here is file that shows expected result
loop_to2.xlsm

[Marc L]

Was confused by single column …

Sub Demo2()
    Application.ScreenUpdating = False
    [RD].Rows(1)(0).Copy [OT]
    ReDim VA(1 To [RD].Rows.Count, 1 To [RD].Columns.Count)

    With CreateObject("System.Collections.SortedList")
        For C& = 1 To [RD].Columns.Count
            For Each V In [RD].Columns(C).Value:  .Item(V) = "":  Next
            For R& = 1 To .Count:     VA(R, C) = .GetKey(R - 1):  Next
            .Clear
        Next
    End With

    [OT].Offset(1).Resize(UBound(VA), UBound(VA, 2)).Value = VA
    [OT].CurrentRegion.HorizontalAlignment = xlCenter
End Sub 

You may like it !

[saputroa272]

Was confused by single column …

Sub Demo2()
    Application.ScreenUpdating = False
    [RD].Rows(1)(0).Copy [OT]
    ReDim VA(1 To [RD].Rows.Count, 1 To [RD].Columns.Count)

    With CreateObject("System.Collections.SortedList")
        For C& = 1 To [RD].Columns.Count
            For Each V In [RD].Columns(C).Value:  .Item(V) = "":  Next
            For R& = 1 To .Count:     VA(R, C) = .GetKey(R - 1):  Next
            .Clear
        Next
    End With

    [OT].Offset(1).Resize(UBound(VA), UBound(VA, 2)).Value = VA
    [OT].CurrentRegion.HorizontalAlignment = xlCenter
End Sub 

You may like it !

wow, superb Marc L
one last thing, can we display the result vertically in a single column that i'm talking about

[Marc L]

Clear U & V columns except titles …

Sub Demo1()
    ReDim VA(1 To [RD].Count, 1 To 2)
    [OT].CurrentRegion.Offset(1).Clear

    With CreateObject("System.Collections.SortedList")
        For C& = 1 To [RD].Columns.Count
            For Each V In [RD].Columns(C).Value:  .Item(V) = "":  Next
                                             VA(R& + 1, 1) = C
            For L& = 1 To .Count:   R = R + 1:    VA(R, 2) = .GetKey(L - 1):  Next
            .Clear
        Next
    End With

    [OT].Offset(1).Resize(R, 2).Value = VA
End Sub 

You must like it ‼

[saputroa272]

Clear U & V columns except titles …

Sub Demo1()
    ReDim VA(1 To [RD].Count, 1 To 2)
    [OT].CurrentRegion.Offset(1).Clear

    With CreateObject("System.Collections.SortedList")
        For C& = 1 To [RD].Columns.Count
            For Each V In [RD].Columns(C).Value:  .Item(V) = "":  Next
                                             VA(R& + 1, 1) = C
            For L& = 1 To .Count:   R = R + 1:    VA(R, 2) = .GetKey(L - 1):  Next
            .Clear
        Next
    End With

    [OT].Offset(1).Resize(R, 2).Value = VA
End Sub 

You must like it ‼

great, youre genius Marc L
thank you very much