none
Copy and Past Unique Values of a Table Field RRS feed

  • Question

  • Hello all.

    The title is pretty self-explanatory.

    I have a table that is structured like so:

    Code          Group

    1                   A

    2                   A

    3                   B

    4                   B

    5                   B

    6                   C

    etc.               etc.

    I would like to write some VBA code that will go through the second column and essentially "extract" unique strings and paste them to another worksheet. So that the end result would be like so:

    Group

    A

    B

    C

    D

    etc.

    I do already have somewhat of a solution. Although, for whatever reason it seems to be duplicating the first group twice. I'll paste the code block.

    Sub CreateNewTable()
    
    'Clears the contents of the NewTable sheet of the outdated table.
    Sheets(2).UsedRange.Clear
    Sheets(2).Range("A1").Value = "GROUP"
    
    'Inputs the various groups to the table range.
    Sheets(1).Range("B2:B" & Rows.Count)._
    AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(2). _
    Range("A2"), Unique:=True
    Sheets(2).ListObjects.Add(xlSrcRange, _
    Sheets(2).UsedRange, , xlYes).Name = "Standard_Hours_Table"
    
    End Sub
    

    So, basically instead of the desired result typed above, I am getting something like this:

    Group

    A

    A

    B

    C

    D

    etc.

    So, does someone besides myself see the issue with the flawed solution in the given code block?

    Alternatively, can someone come up with a better solution than this?

    Thank you for your help and time.

    Tuesday, July 18, 2017 7:02 PM

All replies

  • Hi EternalValhalla,

    please refer example below.

    Data in Sheet1.

    code:

    Sub demo()
    
    Dim rng As Range
    Dim dt As Object
    Dim InputRng As Range
    Set dt = CreateObject("Scripting.Dictionary")
    Set InputRng = Application.Selection
    Set InputRng = Application.InputBox("Range :", , InputRng.Address, Type:=8)
    
    For Each rng In InputRng
        If rng.Value <> "" Then
            dt(rng.Value) = ""
        End If
    Next
    Worksheets("Sheet2").Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys)
    End Sub

    just select the range in the sheet and run the code, you will get result in Sheet 2.

    Output:

    you can try to modify the code as per your requirement.

    I also try to test your code on my side, I made some changes in your code. now its working correctly.

    below is your updated code:

    Sub CreateNewTable()
    
    'Clears the contents of the NewTable sheet of the outdated table.
    Sheets(2).UsedRange.Clear
    'Sheets(2).Range("A1").Value = "GROUP"
    
    'Inputs the various groups to the table range.
    Sheets(1).Range("B1:B" & Rows.Count).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(2). _
    Range("A1"), Unique:=True
    Sheets(2).ListObjects.Add(xlSrcRange, _
    Sheets(2).UsedRange, , xlYes).Name = "Standard_Hours_Table"
    
    End Sub

    Output:

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.


    Wednesday, July 19, 2017 1:16 AM
    Moderator