Loop to create Object

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"

Please Login or Register  to view this content.

loop_to.xlsm
any help will be appreciated

PHP Code: 

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 » !

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

Was confused by single column …

PHP Code: 

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 !

Originally Posted by Marc L

Was confused by single column …

PHP Code: 

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

Clear U & V columns except titles …

PHP Code: 

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 ‼

Originally Posted by Marc L

Clear U & V columns except titles …

PHP Code: 

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