Copy and paste Unique values only

[Chewyhairball]

Hi

I will be selecting data from a tab using Carl-A. I will then paste this data into a new sheet.
The first column is ID numbers, some of which will show up multiple times.

What I would like is to copy all the data but only paste the rows with Unique values in the first column.

So for example if the ID 1234 appears more than once then all instances do not get pasted into the new sheet.

thanks

rory

 

[Chewyhairball]

Hi Bebo, your code runs good but it is pasting duplicate values (of the first column in the table) and not unique values.

thanks

 

[bebo021999]

Hi Bebo, your code runs good but it is pasting duplicate values (of the first column in the table) and not unique values.

thanks

Not test, but may be, replace this:

For Each key In dic.keys
                If rng(i, 1) = key And dic(key) = 1 Then rng(i, 1) = "#N/A"
            Next

by this

For Each key In dic.keys
                If rng(i, 1) = key And dic(key) > 1 Then rng(i, 1) = "#N/A"
            Next

 

[Chewyhairball]

Not test, but may be, replace this:

For Each key In dic.keys
                If rng(i, 1) = key And dic(key) = 1 Then rng(i, 1) = "#N/A"
            Next

by this

For Each key In dic.keys
                If rng(i, 1) = key And dic(key) > 1 Then rng(i, 1) = "#N/A"
            Next

Thank you. That works.

Much appreciated.

Rory

 

[Chewyhairball]

OK, so two different ways of coming at the same issue.
Just wanted to make sure that we didn't duplicate questions, as per rule 12 here: Message Board Rules

I have some ideas on the other one, but before I do that, did bebo02199's solution work for you?
If so, then I am guessing that you probably don't need the other one.

Bebo's solution worked.

thanks

Rory

 

[Peter_SSs]

If I have understood correctly then this can be done much more directly & simply.
I have written this as an ordinary sub as I wasn't sure you would want the code firing every time you select anything in the worksheet. However, you can make it into a Selection_Change event if you want.
I have assumed that there is a heading row and that will be part of your selection before running the code.

Sub UniquesOnlyToNewSheet()
  Dim rCrit As Range

  With Selection
    If .Rows.Count > 1 Then
      Set rCrit = Cells(1, Columns.Count).Resize(2)
      rCrit.Cells(2).Formula = Replace(Replace("=COUNTIF(#,^)=1", "#", .Resize(.Rows.Count - 1, 1).Offset(1).Address), "^", .Cells(2, 1).Address(0, 0))
      Worksheets.Add
      .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Range("A1"), Unique:=False
      rCrit.ClearContents
    End If
  End With
End Sub

 

[Chewyhairball]

Sub UniquesOnlyToNewSheet() Dim rCrit As Range With Selection If .Rows.Count > 1 Then Set rCrit = Cells(1, Columns.Count).Resize(2) rCrit.Cells(2).Formula = Replace(Replace("=COUNTIF(#,^)=1", "#", .Resize(.Rows.Count - 1, 1).Offset(1).Address), "^", .Cells(2, 1).Address(0, 0)) Worksheets.Add .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Range("A1"), Unique:=False rCrit.ClearContents End If End With End Sub

Thanks. This might come in handy at some point and always good to have options