Create a single column with unique entries from N columns

[polarisking]

I've attached a file with 4 columns and 5 rows (excluding the header row). I want to create a new column containing only the unique values for the 25 values (in my example it's 8). I'd like the process to run for N columns.

Any ideas would be appreciated.

 

[Luke M]

I use this macro pretty often when I need a Unique list. I've got it hotkeyed on my computer to the shortcut Ctrl+Alt+U. It's currently set to make the list on a new sheet, but you could modify to have it go anywhere, really.

Sub GetUniqueList()


    Dim rCell As Range
    Dim colUnique As Collection
    Dim sh As Worksheet
    Dim i As Long
   
    'only work on ranges
   If TypeName(Selection) = "Range" Then
       
        'create a new collection
       Set colUnique = New Collection
       
        'loop through all selected cells
       'and add to collection
       For Each rCell In Selection.Cells
            On Error Resume Next
                'if value exists, it won't be added
               colUnique.Add rCell.Value, CStr(rCell.Value)
            On Error GoTo 0
        Next rCell
       
        'make a new sheet to put the unique list
       Set sh = ActiveWorkbook.Worksheets.Add
       
        'Write the unique list to the new sheet
       For i = 1 To colUnique.Count
            sh.Range("A1").Offset(i, 0).Value = colUnique(i)
        Next i
       
        'sort with no headers
       sh.Range(sh.Range("A2"), sh.Range("A2").End(xlDown)) _
            .Sort sh.Range("A2"), xlAscending, , , , , , xlNo
       
    End If
   
End Sub

 

[polarisking]

Thanks, Luke. I developed this, which is lightening fast (probably an accident).

Option Explicit
Sub LastRowInNColumns()
Dim LastRow  As Long 'LastRow in Column being searched
Dim AddRemRow  As Long 'next row position to add range from Column being searched
Dim CurrCol  As Long 'Column being searched
Dim TabColumnsToBeSearched As String 'Name of Tab containing Columns being searched
Dim TabAddRemove  As String 'Name of Tab containing Unique Values
TabAddRemove = "AddRemove" 'Specify name of Tab containing Unique Values
TabColumnsToBeSearched = "SchedID" 'Specify Name of Tab containing Columns being searched
'================================================
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'================================================
'================================================
'Delete Unique Tab, if it exists; create a blank one
On Error Resume Next
  Sheets(TabAddRemove).Delete
On Error GoTo 0
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = TabAddRemove
'================================================
'Activate tab with Columns to be searched
Sheets(TabColumnsToBeSearched).Activate
AddRemRow = 2
CurrCol = 1
Sheets("AddRemove").Range("A1") = "Unique SchedIDs" 'Title the Column
With ActiveSheet
'================================================
' Cycle through each Column checking for a value in A+Column#
' Calculate the # of rows, copy the range, paste into the next available slot in the Unique tab
  Do While Range(Cells(1, CurrCol), Cells(1, CurrCol)) > ""
  LastRow = .Cells(.Rows.Count, CurrCol).End(xlUp).Row
  Debug.Print "Column: " & CurrCol & " - Rows: " & LastRow - 1
  Range(Cells(2, CurrCol), Cells(LastRow, CurrCol)).Copy Sheets("AddRemove").Range("A" & AddRemRow)
  AddRemRow = AddRemRow + LastRow - 1
  CurrCol = CurrCol + 1
  Loop
  
End With
'================================================
' Active the Unique Tab; Remove the Dupes; Display the number of rows - 1
Sheets("AddRemove").Activate
Range("A:A").RemoveDuplicates Columns:=Array(1), Header:=xlYes
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Debug.Print "Unique Values: " & LastRow - 1
'================================================
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
'================================================
  
End Sub