Eliminating duplicates with data in multiple columns

[EdStockton]

Hi Folks,

I need assistance with eliminating duplicates occurring in multiple columns in a worksheet.

An example if the worksheet is as follows:

[TABLE="width: 500"]
<tbody>[TR]
[TD]1
[/TD]
[TD]10
[/TD]
[TD]20
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]11
[/TD]
[TD]21
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]12
[/TD]
[TD]22
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]13
[/TD]
[TD]23
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]14
[/TD]
[TD]24
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]15
[/TD]
[TD]25
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]16
[/TD]
[TD]26
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]17
[/TD]
[TD]27
[/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]18
[/TD]
[TD]28
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]19
[/TD]
[TD]29
[/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]20
[/TD]
[TD]30
[/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]21
[/TD]
[TD]31
[/TD]
[/TR]
</tbody>[/TABLE]

When duplicates are eliminate, I should see a list numbered from 1 to 31.

Thank you for your assistance.

Sincerely, Ed Stockton

 

[miless2111s]

do you want to go from a 3 column list to a 1 column list with all dups removed? Are the lists always the same length?

 

[EdStockton]

I would prefer to have the result all in one column. Usually the columns are not of equal length. Column A may be 30, column B 15, column C 2, column D 1000, etc.

 

[miless2111s]

when I am combining columns I will count the rows (COUNT statement) and then I know the columns. This then allows me to have separate area where I can use an offset statement to just pull the information in. I can then de-dup with a pivot table.

So - Data in A1:C12
F1 Rows
F2 Colums
H2 =COUNT(A:A)-1 (note that if you've got different lengths you'll have to do something smart with Max etc
H3 =2

I1 Row
J1 Column
K1 Value
I2 =0
J2 = 0
K2 =OFFSET($A$1,I2,J2) - Copy down as far as you need to go.

I3 =IF(I2+1<=$G$1,I2+1,0) - Copy down as far as you need to go
J3 =IF(I3=0,J2+1,J2) - copy down as far as you need to go.

Then pivot table on the contents of K to produce a unique and ordered list. You can of course pull that out of the pivot using =

Hope that helps
Miles

 

[EdStockton]

Hi miless2111s,

Thanks for that idea. I really do not know anything about pivot tables. I was hoping for more of a macro approach or maybe even an IF statement type of solution.

Sincerely, Ed Stockton

 

[hiker95]

EdStockton,

Here is a macro solution for you to consider that uses two arrays in memory, and, will adjust to the number of raw data rows, and, columns, in the active worksheet.

The results will be written beginning in the column, two columns to the right of the last used column in the active worksheet.

Sample raw data, and results in the active worksheet:

Excel 2007
	A	B	C	D	E	F
1	1	10	20	13		1
2	2	11	21	14		2
3	3	12		15		3
4	4			16		4
5	5			17		5
6	6			18		6
7	7	13		19		7
8	8	14		20		8
9	9	15		21		9
10	10			22		10
11	11			23		11
12	12			24		12
13				25		13
14				26		14
15				27		15
16				28		20
17				29		21
18				30		16
19				31		17
20						18
21						19
22						22
23						23
24						24
25						25
26						26
27						27
28						28
29						29
30						30
31						31
32
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub GetUniqueNumbers()
' hiker95, 03/10/2016, ME927215
Dim a As Variant, i As Long, d As Object
Dim o As Variant
Dim lr As Long, lc As Long, c As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc)).Value
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  For c = 1 To lc
    For i = 1 To UBound(a, 1)
      If Not a(i, c) = vbEmpty Then
        If Not d.Exists(a(i, c)) Then
          d(a(i, c)) = d(a(i, c))
        End If
      End If
    Next i
  Next c
  o = d.Keys
  .Cells(1, lc + 2).Resize(UBound(o) + 1) = Application.Transpose(o)
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the GetUniqueNumbers macro.

 

[EdStockton]

Thanks, Hiker95. That was exactly what I needed. It worked without a hitch.

You guys are really good on here.

 

[hiker95]

EdStockton,

You are very welcome. Glad I could help.

And, come back anytime.

 

[kalak]

Couple of other codes if you're interested.
These also count the times each value occurs, but you don't have to list the count if you don't wants to.
The first uses the scripting dictionary, which is briefer code but relatively slow for this type of problem (although you may find it fast) particularly if you've got a very large dataset. Also the scripting dictionary won't run on a Mac computer.
The second code is longer, faster and should run on any computer.

Sub scrid()

Dim d As Object, a, c
Set d = CreateObject("scripting.dictionary")
a = Cells(1).CurrentRegion

For Each c In a
    d(c) = d(c) + 1
Next c

[i1].Resize(d.Count, 2) = Application.Transpose(Array(d.Keys, d.items))

End Sub

Sub array()

Const n = 10 ^ 5
Dim b&(-n To n), x(n) As Boolean, a, c
a = Cells(1).CurrentRegion
For Each c In a
    b(c) = b(c) + 1
    x(c) = True
    If b(c) = 1 Then q = q + 1
Next c

ReDim u(1 To q, 1 To 2)
For Each c In a
    If x(c) Then
        k = k + 1
        u(k, 1) = c
        u(k, 2) = b(c)
        x(c) = False
    End If
Next c

[l1].Resize(k, 2) = u

End Sub