Getting unique values from a column

user_15032207 0
Viewed 119

The task at hand is to search in column A to see what values I have (they are in form of letters) and paste for each unique entry, its value once in another column.

Here is a visual explanation:

Visual example of the table and action I need

What I came up with was to create a For loop that iritiates through column A and created a conditional that if it found a certain value then it would insert the value in the range. Here is the code:

For i = 1 to 26

if cells(i,26).value= "A" Then

Range ("C1")= "A"

Elseif cells(i,26).value = "B" then
Range ("C2").value = "B"
ElseIf (i,26).value = "C" then 
Range ("C3").value = "C"
EndIf
Next i
end sub

I want to cut this process short as my data set is really big with lots of company names. Any recommendations? I believe there has to be a way of knowing the values without having to look at all the values yourself.

vba excel
4 Answers

If the goal is to just get a unique list of values found in Column A output to Column C you can use the below macro. This is really just recreating the steps of one method you would manually take to find unique values. Not the most sophisticated solution, but it works

  1. Create a copy of your column with company names (using last available column in sheet)
  2. De-dup the helper column
  3. Copy the de-duped column to destination
  4. Delete the helper column

Assumes the last column on worksheet is not used

Sub Unique()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, lc As Long

'Determine Range Size
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
lc = ws.Cells(1, ws.Columns.Count).Column

'Copy Company Names To Helper Column/Remove Duplicates
ws.Range("A2:A" & lr).Copy ws.Cells(1, lc)
ws.Columns(lc).RemoveDuplicates Columns:=1, Header:=xlNo
lr = ws.Cells(ws.Rows.Count, lc).End(xlUp).Row

'Output Unique Values From Helper Column
ws.Range(ws.Cells(1, lc), ws.Cells(lr, lc)).Copy
ws.Range("C2").PasteSpecial xlPasteValues

'Delete Helper Column
ws.Columns(lc).Delete

End Sub

Note my comment on post. VBA may not be needed here at all

user_67064190

Here's a slightly different version of using .RemoveDuplicates which also removes blank cells.

You can also do this without VBA. Just copy the desired column to another and use Remove Duplicates under Data tab.

Sub Unique_Values()

   Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
   
    'Getting all the values in column A (except header)
    'Copying them into cell C2 and below
    ws.Range("A2", Range("A1048576").End(xlUp)).Copy Range("C2")
    
    'setting the header for the column C
    ws.Range("C1").Value = "What companies are in Column A?"
    
    'Removing duplicates and blanks from column C
    With ws.Range("$C$2", Range("C1048576").End(xlUp))
        .Value = .Value
        .RemoveDuplicates Columns:=1, Header:=xlNo
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
       On Error GoTo 0
    End With

End Sub

Although I agree with the coding convention used in the other answer, I think it is over-complicating the problem a little bit that would cause confusion for beginners.

user_64614620

I think both answers so far will give you exactly what you want, and perhaps could be simplified even further?

Sub GetUniqueQuick()
Dim LastRow As Long
Application.ScreenUpdating = False  
LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Sheet1").Range("A2:A" & LastRow).Copy Sheets("Sheet1").Range("C2")    
Sheets("Sheet1").Range("C1:C" & LastRow).RemoveDuplicates Columns:=1, Header:=xlYes

End Sub
Admin1

Using the dynamic features of MS 365 you can simply apply the worksheet function UNIQUE() over a given range, e.g.

= UNIQUE(A2:A100)

or integrate it in a user defined function

Function GetCompanies(rng As Range)
    If rng.Columns.Count > 1 Then Exit Function    ' allow only one column
    GetCompanies = Application.Unique(rng)         ' return function result as 2-dim array
End Function

As empty cells result in pseudo-uniques with a 0 output, you could call them in formula with an added cosmetical blank string :

=GetCompanies(A2:A100)&""
user_64602970
Related