Get Unique

[billandrew]

Evening all

Attempting to modify the code below which combines/joins Column A & Column B into Column C on Sheet1 then removes the duplicate value and places them on Sheet 2.

Looking to join Column A & Column B and remove duplicates and place in Sheet1, Starting at [C1]

This is the current code

Sub Unique2Colum()   Dim ary As Variant
   Dim d As Object
   Dim c As Variant
   Dim lastrow As Long
   Dim i As Long, j As Long
   Dim sh As Worksheet, sh2 As Worksheet
   Set sh = Worksheets("Sheet1")
   Set sh2 = Worksheets("Sheet2")
   
   ary = sh.Range("A2", Range("A" & Rows.Count).End(xlUp).Offset(, 2)).Value
   For i = 1 To UBound(ary)
      ary(i, 3) = ary(i, 1) & " " & ary(i, 2)
   Next i
   sh.Range("C1").Resize(UBound(ary)).Value = Application.Index(ary, 0, 3)
   
   Set d = CreateObject("Scripting.Dictionary")
    lastrow = sh.Cells(Rows.Count, 3).End(xlUp).Row
    c = Range("c1:c" & lastrow)
        For j = 1 To UBound(c, 1)
        d(c(j, 1)) = 1
        Next j
    sh2.Range("A1").Resize(d.Count) = Application.Transpose(d.Keys)
End Sub

This is my bad attempt to perform the aforementioned request/assistance.

Sub GetUniques2Columns()Dim c As Range
Dim v As String


With CreateObject("Scripting.dictionary")
For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
v = Join(Application.Index(c.Resize(, 2).Value, 1, 0), "|")
If Not .exists(v) Then
.Add v, Nothing
End If
Next c


For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
v = Join(Application.Index(c.Resize(, 2).Value, 1, 0), "|")
'If .exits(v) Then c.offset(, col) [COLOR=#ff0000]I believe this is where i'm going off path, all of above may be off as well[/COLOR]
Next c


End With




End Sub

Any help as always will be appreciated. Trying to get this Scripting Dictionary, a bit difficult at times.

THANK YOU!

 

[footoo]

Why not just change the last line of your original macro so as to put the Dictionary values in column C of Sheet1 instead of column A of sheet2?

Change to :

   sh.Range("c1:c" & lastrow).ClearContents
    sh.Range("c1").Resize(d.Count) = Application.Transpose(d.Keys)

 

[Rick Rothstein]

Evening all

Attempting to modify the code below which combines/joins Column A & Column B into Column C on Sheet1 then removes the duplicate value and places them on Sheet 2.

Looking to join Column A & Column B and remove duplicates and place in Sheet1, Starting at [C1]

I am not clear on what you mean by remove duplicates... do you want all traces of duplicated values removed or only those duplicates after the first occurence of the value removed?

 

[billandrew]

@ Mr. Rothstein

Wish to concatenate Columns A & Columns B and then remove Duplicate values.

 

[Fluff]

If you had the following values. What should the result be?
Just the 2 highlighted values, or should you also get the first 3 rows as well?

Excel 2013 32 bit
	A	B
1	a	1
2	b	2
3	c	3
4	d	4
5	a	1
6	b	2
7	c	3
8	d	5
Sheet2

 

[billandrew]

@ footoo

This adjustment does the trick.

Thank You.

 

[billandrew]

@Fluff

Should be

a1

b2

c3

d4

d5

<tbody>
</tbody>

 

[Rick Rothstein]

@Fluff

Should be

a1

b2

c3

d4

d5

<tbody>
</tbody>

Here is a somewhat shorter alternate non-looping macro that you can consider. Note that I put a space between the concatenated values (delete the red highlighted part of the code if you don't want the space there) because your originally posted code did so...

[table="width: 500"]
[tr]
	[td]Sub Unique2Colum()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C1:C" & LastRow) = Evaluate("A1:A" & LastRow & "&[B][COLOR="#FF0000"]"" ""&[/COLOR][/B]B1:B" & LastRow)
  Range("C1:C" & LastRow).RemoveDuplicates Array(1)
End Sub[/td]
[/tr]
[/table]

 

[billandrew]

Works Great.

As always Thank You Mr. Rothstein.