This tutorial describes multiple ways to extract a unique or distinct list from a column in Excel. This post also covers a method to remove duplicates from a range. It's one of the most common data crunching task in Excel.

Scenario

Suppose you have a list of customer names. The list has some duplicate values. You wish to extract unique values from it. Unique values would be a distinct list. To make it more clear, unique values are the values that appear in a column only once.

Sample File

Click on the link below and download the excel file for reference. We will use this workbook to demonstrate methods to find unique values from a column.

Extract unique values from a column

The dataset contains 13 records. Data starts from cell B3 and ends with cell B15. Header of the list exists in cell B2.
LIST1 Jhonson Jhonson Jhonson Dave Dave Deepanshu Sohan Neha Deepanshu Neha Deepanshu Neha Sohan
See the snapshot of actual data in images below.

4 Methods to Extract Unique Values

  1. Advanced Filter
  2. Index- Match Array Formula
  3. Excel Macro (VBA)
  4. Remove Duplicates

The above methods are explained in detail in the following sections.



Solutions

1. Advanced Filter


Follow the steps shown in the animation below

 

Steps to extract unique values using Advanced Filter

  1. Go to Data tab in the menu
  2. In Sort and Filter box, Click Advanced button 
  3. Choose "Copy to another location"
  4. In "List range :" box, select a range from which unique values need to be extracted (including header)
  5. In "Copy to :" box, select a range in which final output to be put
  6. Check Unique records only
  7. Click Ok


2. INDEX-MATCH (Array Formula)

 
Extract Unique Values - Formula


FORMULA 

=IFERROR(INDEX($B$3:$B$15, MATCH(0,COUNTIF($D$2:D2, $B$3:$B$15), 0)),"")

Hit CTRL+ SHIFT + ENTER to confirm this formula as it's an array formula. If done correctly, Excel will automatically place curly braces {...} around the formula.

 

After placing curly braces, the above formula would look like this :

 

{=IFERROR(INDEX($B$3:$B$15, MATCH(0,COUNTIF($D$2:D2, $B$3:$B$15), 0)),"")}


Copy the above formula and paste it into cell D3. And paste it down till the cell D12 (Select the range D3:D12 and press Ctrl+D).

 

HOW TO USE

The functioning of this method is visible in the animated image below.

 

Version 2 : IF BLANK VALUES IN A LIST

 

Suppose there are missing or blank values in your list from which you want to extract unique values. In this case, you need to tweak your formula. The modified formula is explained below -

 

 
Extract Unique Values given blank values

 

FORMULA


=IFERROR(INDEX($B$3:$B$15, MATCH(0,IF(ISBLANK($B$3:$B$15),1,COUNTIF($D$2:D2, $B$3:$B$15)), 0)),"")

Copy the above formula and paste it into cell D3. And paste it down till the cell D12 (Shortcut key : Ctrl+D).

You need to press CTRL+ SHIFT + ENTER  to submit this formula. It is different than the standard ENTER button to enter a formula. If you do it right, MS Excel will put curly braces {...} around the formula. It would view like this :

 

{=IFERROR(INDEX($B$3:$B$15, MATCH(0,IF(ISBLANK($B$3:$B$15),1,COUNTIF($D$2:D2, $B$3:$B$15)), 0)),"")}

How this formula works


First we need to understand the meaning and use of array formula.

Array formula allows you to process a certain operation on multiple values using a single function. In other words, we can perform some calculation on more than one value without doing it manually on each cell. For example, you want to multiply each value by 5 and then sum all of the returned values.from multiplication. Suppose following values are stored in cell A1:A3
25 35 45
Enter the formula  =SUM(A1:A3*5) with CTRL+SHIFT+ENTER. It returns 525. In this case, it is doing matrix multiplication and then adds all the numbers.

Functioning of Formula : Step by Step

Step 1 : COUNTIF($D$2:D2, $B$3:$B$15)

 

Syntax : COUNTIF(range, condition)
It counts the number of cells within a range that meet the given condition

COUNTIF($D$2:D2, $B$3:$B$15) returns 1 if $D$2:D2 is found in $B$3:$B$15 else 0.

 

For example, for the second distinct record Dave, the formula becomes COUNTIF($D$2:D3, $B$3:$B$15). It is searching values D2 and D3 in the range B3:B15. The array becomes 

={1;1;1;0;0;0;0;0;0;0;0;0;0}. It is 1 when values of D2 and D3 are found and 0 where it is not found.

 

Step 2 : In this step, we are checking the position of item that has an array value 0 in Step I.

 

Syntax : MATCH(lookup_value;lookup_array; [match_type] 

It gives the relative position of an item in an array that matches a specified value.

 

MATCH(0,COUNTIF($D$2:D2, $B$3:$B$15), 0) returns 4 for the second distinct value. It is 4 because the value Dave is placed in the fourth position of the list. [Also see 0 is the fourth value of the step 1 array - {1;1;1;0;0;0;0;0;0;0;0;0;0}]

 

Step 3 : In this step, we extract the desired distinct value. The INDEX function helps to achieve it.

 

Syntax : INDEX(array,row_num,[column_num])

The INDEX function returns the reference of cell meeting row and column number in a given range.

INDEX($B$3:$B$15, MATCH(0,COUNTIF($D$2:D2, $B$3:$B$15), 0)) returns Dave.

 


Tutorial : Excel Array Formula with Examples

3. MACRO (Advanced Filter)

It's an excel macro to find distinct values from a column in Excel. In this method, we are using the same logic as we have done in first method i.e. Advanced filter. Here, we are applying advanced filter via excel macro rather than doing it manually.


VBA CODE



How to create unique list using macro

1. Go to excel sheet where data exists.
2. Press Alt + F11 to open VB editor window

3. Go to Insert menu >> Module. It will create a module.

4. In the module, copy and paste the above vba code into the window
5. Close VB Editor Window
6. Go back to your sheet
7. Press Alt + F8. Select CreateUniqueList under Macro name box and Hit Run button.

Download the workbook
Customise Macro Code

The following are two most frequently asked questions about above excel macro with solutions. If you have any other question regarding the macro, post your question on comment box below.

Q. How to paste unique values to another existing worksheet?

Change ActiveSheet.Range("D2") to Sheets("newsheet").Range("D2")

In the above code, change "newsheet" to the name of the existing sheet wherein you want to paste unique values.

Q. How to paste unique values in a new worksheet?

Use the program below. It will paste distinct values to a new worksheet named "mysheet". You can change it to any name you want -

Option Explicit
Sub CreateUniqueList()
Dim lastrow As Long
Dim ws As String
ws = ActiveSheet.Name
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
Sheets.Add.Name = "mysheet"
Sheets(ws).Range("B2:B" & lastrow).AdvancedFilter _
    Action:=xlFilterCopy, _
    CopyToRange:=Sheets("mysheet").Range("D2"), _
    UNIQUE:=True
End Sub


I have added one more way to extract unique values from a range [Updated : June 2016]

4. Remove Duplicates Option 

The most easiest way to extract unique values from a range is to use "Remove Duplicates" option. See the snapshot below -

 
Unique values : Remove Duplicates Option

Warning : If you want to keep your original data (not overwrite unique values), make a copy of it (Paste original data to another range or tab) Otherwise original data would be removed.

Steps to remove duplicates

Select range >> Go to Data option >> Click on Remove Duplicates >> Select the column that contains duplicates >> Ok

Important Note :

  1. If you have multiple columns in a range and you want to remove duplicates based on a single column, make sure only the column that contains duplicates is selected.
 
Remove Duplicates by a column

2. If you want to remove duplicates based on all the columns (whole row), make sure all the columns are selected.

'VBA' 카테고리의 다른 글

[VBA] Extract Unique Value (Distinct)  (0) 2021.04.23
[VBA] Specific Data Distraction  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23
블로그 이미지

remoted

Remoted's IT LAB & POST DATABASE

댓글을 달아 주세요

엑셀 파일 다운로드

여학생70점이상만 복사.xlsm

0.02MB

Sub Test_01()

Dim lngE As Long
Dim rngD As Range
Dim i As Long

lngE = Cells(Rows.Count, "b").End(xlUp).Row

    For i = 3 To lngE
        If Range("e" & i) = "여" Then
            If rngD Is Nothing Then
                Set rngD = Range("e" & i).Offset(0, -3).Resize(1, 10)
            Else
                Set rngD = Union(rngD, Range("e" & i).Offset(0, -3).Resize(1, 10))
            End If
        End If
    Next

    If rngD Is Nothing Then
        MsgBox "복사할 범위가 없습니다."
    Else
        Range("p3").CurrentRegion.Offset(1, 0).Clear
        rngD.Copy Range("p3")
    End If
Range("a1").Select
End Sub
Sub Test_03()

Dim lngE As Long
Dim rngD As Range
Dim i As Long

lngE = Cells(Rows.Count, "b").End(xlUp).Row

     For i = 3 To lngE
          If Range("e" & i) = "여" And Range("k" & i) >= 60 Then
                   '여학생이면서 평균 60점 이상
               If rngD Is Nothing Then
                    Set rngD = Range("e" & i).Offset(0, -3).Resize(1, 10)
                   'rngD.Select
                        '단계별 실행에서 확인용
               Else
                    Set rngD = Union(rngD, Range("e" & i).Offset(0, -3).Resize(1, 10))
                    'rngD.Select
                        '단계별 실행에서 확인용
     
          End If
          End If
     Next

     If rngD Is Nothing Then
          MsgBox "복사할 범위가 없습니다."
     Else
          Range("p3").CurrentRegion.Offset(1, 0).Clear
          rngD.Copy Range("p3")
     End If

Range("a1").Select
End Sub

 



출처: https://withseok.tistory.com/266 [with Seok]


'VBA' 카테고리의 다른 글

[VBA] Extract Unique Value (Distinct)  (0) 2021.04.23
[VBA] Specific Data Distraction  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23
블로그 이미지

remoted

Remoted's IT LAB & POST DATABASE

댓글을 달아 주세요

[VBA] last Data Cell Searching

VBA 2021. 4. 23. 01:54

www.oppadu.com/%EC%97%91%EC%85%80-vba-%EB%A7%88%EC%A7%80%EB%A7%89-%EC%85%80-%EC%B0%BE%EA%B8%B0-%EB%A7%88%EC%A7%80%EB%A7%89-%ED%96%89-%EC%B0%BE%EA%B8%B0/

'VBA' 카테고리의 다른 글

[VBA] Extract Unique Value (Distinct)  (0) 2021.04.23
[VBA] Specific Data Distraction  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23
블로그 이미지

remoted

Remoted's IT LAB & POST DATABASE

댓글을 달아 주세요

1. 시트 추가

아래는 시트를 추가하는 소스의 예제이다.

Sub AddSheets()
    Sheets.Add
    Sheets.Add after:=Sheets(2)
    Sheets.Add before:=Sheets(2)
End Sub

Sheets.Add는 실행한 시트 왼쪽에 새로운 시트를 만든다.

Sheets.Add after:=Sheets(인덱스 번호)는 인덱스 번호에 있는(2의 경우 두번째 시트)시트를 기준으로 오른쪽에

새로운 시트를 생성한다.

Sheets.Add before:=Sheets(인덱스 번호)는 인덱스 번호에 있는(2의 경우 두번째 시트)시트를 기준으로 왼쪽에

새로운 시트를 생성한다.

 

2. 시트 삭제

아래는 시트를 삭제하는 소스의 예제이다.

Sub DeleteSheets()
    Sheets(5).Delete
End Sub

Sheets(인덱스 번호).Delete는 해당 인덱스 번호의 시트(5의 경우 다섯번째 시트)를 삭제한다.

단 데이터가 있는 경우 삭제확인을 한다.

 

삭제 확인을 안보고 싶다면 Sheets(인덱스 번호).Delete 위에 

Application.DisplayAlerts = False

를 추가해주면 된다. 단 위 구문 이후에는 경고창이 안나오기 때문에 되돌리고 싶다면

위 구문에서 False를 True로 해주면 된다.

'VBA' 카테고리의 다른 글

[VBA] Specific Data Distraction  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23
Data Distraction and Data-analyzing-insertion  (0) 2021.04.23
블로그 이미지

remoted

Remoted's IT LAB & POST DATABASE

댓글을 달아 주세요

[VBA] Specific Data Deleting

VBA 2021. 4. 23. 01:52

mainia.tistory.com/1235

 

엑셀(Excel) VBA – 매크로 이용해서 특정 조건의 데이터를 삭제하고 싶을 때

엑셀(Excel) VBA – 매크로 이용해서 특정 조건의 데이터를 삭제하고 싶을 때 환경: Microsoft Excel 365 엑셀시트의 자료에서 특정행을 삭제하는데 수작업으로 가능하지만 양이 많을때는 VBA 코드를 짜

mainia.tistory.com

 

'VBA' 카테고리의 다른 글

[VBA] Specific Data Distraction  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23
Data Distraction and Data-analyzing-insertion  (0) 2021.04.23
블로그 이미지

remoted

Remoted's IT LAB & POST DATABASE

댓글을 달아 주세요

목적

: 엑셀에서 특정한 시트 하나만 남기고 모두 삭제 or 원하는 시트만 남기고 모두 삭제하기

 

실행 결과

: 지정한 시트만 남고 모두 삭제됨

 

코드

Sub DeleteSheet()

    Dim xWs As Worksheet
    Application.ScreenUpdating = False
 	Application.DisplayAlerts = False
    'Error Window Hidden

    For Each xWs In Application.ActiveWorkbook.Worksheets

    	If xWs.Name <> "Sheet1" And xWs.Name <> "남길시트이름" Then 'Sheet1 과 남길시트이름 두개만 남기고 모두 삭제됨
    		xWs.Delete
    	End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
	'Error Window Option Activate


End Sub

'VBA' 카테고리의 다른 글

[VBA] Specific Data Distraction  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23
Data Distraction and Data-analyzing-insertion  (0) 2021.04.23
블로그 이미지

remoted

Remoted's IT LAB & POST DATABASE

댓글을 달아 주세요

    Dim lastrow As Long
    Dim lngE As Long
    Dim rngD As Range
    Dim i As Long
    
    
    Dim j As Long
    Dim Data As Long
    Dim xLastRow As Long
    
    
    Dim RealDataLastRow As Long

    Dim DeletedWantedRow As Long

    Dim LastLoopIndex As Long
    
    Dim co As Long
    Dim incRow As Long
    
    Dim k As Long
    Dim LastDateTime As Long
    
    
     Dim xWs As Worksheet


    lastrow = Sheets("20210421").Cells(Rows.Count, "F").End(xlUp).Row
    Sheets("20210421").Range("F2:F" & lastrow).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=Sheets("Sheet1").Range("B5"), _
        Unique:=True
    'DIstinct Part
    
  

     'Dintct 된 데이터 갯수만큼의 전처리시트가 필요
    
    xLastRow = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row - 4
    ' 6 제대로 나왔음 -> 데이터의 총 갯수
    
    
    For j = 1 To xLastRow
        ' 1 2 3 4 5 6
        
        lngE = Sheets("20210421").Cells(Rows.Count, "F").End(xlUp).Row
        
        For i = 2 To lngE
            If Sheets("20210421").Range("F" & i).Value = Sheets("Sheet1").Range("B" & (4 + j)).Value Then
                If rngD Is Nothing Then
                    Set rngD = Sheets("20210421").Range("F" & i).Offset(0, -5).Resize(1, 6)
                Else
                    Set rngD = Union(rngD, Sheets("20210421").Range("F" & i).Offset(0, -5).Resize(1, 6))
                End If
            End If
        Next
    
        If rngD Is Nothing Then
            MsgBox "복사할 범위가 없습니다."
        Else
            Sheets.Add after:=Sheets(2 + j)
            Sheets(3 + j).Range("A1").CurrentRegion.Offset(1, 0).Clear
            rngD.Copy Sheets(3 + j).Range("A1")
        End If
    
        '시트를 추가하고 데이터 사전 전처리
    
        co = Sheets(3 + j).Range("F1").CurrentRegion.Rows.Count
        
        For incRow = 0 To co
            If Sheets("Sheet1").Range("B" & (4 + j)).Value <> Sheets(3 + j).Cells(1, "F").Offset(0, 0).Value Then
            '시트와 데이터를 비교
                Sheets(3 + j).Range("F1").Select
                Selection.EntireRow.Delete
            End If
        Next
        
        '데이터 사전가공 완료
                     
    Next
    
    
    
    
    For k = 1 To xLastRow
    
        LastDateTime = Sheets(3 + k).Cells(Rows.Count, "B").End(xlUp).Row
    
        '모든 시트의 D1에는 데이터가 있음
        Sheets(3 + k).Activate
        Range("D1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        ' 카피부
        Sheets("Sheet1").Activate
        Cells(5, "E").Offset(k - 1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            
        Sheets("Sheet1").Cells(4 + k, "C").Offset(0, 0).Value = Sheets(3 + k).Range("B1").Value
        Sheets("Sheet1").Cells(4 + k, "D").Offset(0, 0).Value = Sheets(3 + k).Range("B" & LastDateTime).Value
    Next
    
    
    
    '마무리 처리
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Sheet1" And xWs.Name <> "20210421" And xWs.Name <> "Sheet2" Then 'Sheet1 과 남길시트이름 두개만 남기고 모두 삭제됨
            xWs.Delete
        End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Sheets("Sheet1").Activate

'VBA' 카테고리의 다른 글

[VBA] Specific Data Distraction  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23
Data Distraction and Data-analyzing-insertion  (0) 2021.04.23
블로그 이미지

remoted

Remoted's IT LAB & POST DATABASE

댓글을 달아 주세요