unique and no blanks in one formula

nelsok

Board Regular
Joined
Jan 20, 2006
Messages
166
is there a way to get the unique entries from a list with out blanks using only one formula?

currently i use

=if(countif(a$1:a1,a1)=1,a1,"")

to get unique entries

and

Code:
Function NoBlanks(DataRange As Range) As Variant()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NoBlanks
' This function returns an array that consists of the non-blank values
' in DataRange. The function must be array-entered into the complete range
' of worksheet cells that are to receive the result. For example, if
' you want the results in B1:B10, select that range, type
'       =NOBLANKS(A1:A10)
' in B1 and press CTRL+SHIFT+ENTER rather than just enter.
' This will cause the function to fill B1:B10 with the N non-blank
' entries in A1:A10, and place vbNullStrings in N+1 to 10.
' The input DataRange must have exactly 1 row or 1 column. You
' can't enter a two-dimensional array. The formula must be
' entered into a single column or singe row. You cannot
' enter the formula in a two dimensional array. If the formula
' is entered into a two-dimensional range, or if DataRange is a
' two dimensional range, the function will return #REF errors.
' The size of the array is the greater of the number of cells
' into which it was entered and the number of cells in the input
' DataRange.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim N As Long
Dim N2 As Long
Dim Rng As Range
Dim MaxCells As Long
Dim Result() As Variant
Dim R As Long
Dim C As Long

If (DataRange.Rows.Count > 1) And _
    (DataRange.Columns.Count > 1) Then
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' If DataRange is a two-dimensional array, fill
    ' it with #REF errors. We work with only
    ' single dimensional ranges.
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ReDim Result(1 To DataRange.Rows.Count, 1 To DataRange.Columns.Count)
    For R = 1 To UBound(Result, 1)
        For C = 1 To UBound(Result, 2)
            Result(R, C) = CVErr(xlErrRef)
        Next C
    Next R
    NoBlanks = Result
    Exit Function
End If

If (Application.Caller.Rows.Count > 1) And _
    (Application.Caller.Columns.Count > 1) Then
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' If Application.Caller is a two-dimensional array, fill
    ' it with #REF errors. We work with only
    ' single dimensional ranges.
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ReDim Result(1 To Application.Caller.Rows.Count, 1 To Application.Caller.Columns.Count)
    For R = 1 To UBound(Result, 1)
        For C = 1 To UBound(Result, 2)
            Result(R, C) = CVErr(xlErrRef)
        Next C
    Next R
    NoBlanks = Result
    Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the greater of Application.Caller.Cells.Count
' and DataRange.Cells.Count. This is the size
' of the array we'll return. Sizing it to the
' maximum value prevents #N/A error from appearing
' in cells past the end of the array, because
' the array will always fill out the cells
' into which it was entered.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
MaxCells = Application.WorksheetFunction.Max( _
    Application.Caller.Cells.Count, DataRange.Cells.Count)

''''''''''''''''''''''''''''''''''''''''''''
' Resize the array to the proper size.
''''''''''''''''''''''''''''''''''''''''''''
ReDim Result(1 To MaxCells, 1 To 1)
''''''''''''''''''''''''''''''''''''''''''''
' Loop through DataRange and place non-blank
' cells at the front of the array.
''''''''''''''''''''''''''''''''''''''''''''
For Each Rng In DataRange.Cells
    If Rng.Value <> vbNullString Then
        N = N + 1
        Result(N, 1) = Rng.Value
    End If
Next Rng
''''''''''''''''''''''''''''''''''''''''''''
' Fill the remaining array elements with
' vbNullStrings so they don't appear
' as 0 on the worksheet.
''''''''''''''''''''''''''''''''''''''''''''
For N2 = N + 1 To MaxCells
    Result(N2, 1) = vbNullString
Next N2

'''''''''''''''''''''''''''''''''''''''''''
' If the formula was entered into a single
' row across several columns, Transpose the
' result array.
'''''''''''''''''''''''''''''''''''''''''''
If Application.Caller.Rows.Count = 1 Then
    NoBlanks = Application.Transpose(Result)
Else
    NoBlanks = Result
End If

End Function

to get the list without blanks.


thanks.
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

ravishankar

Well-known Member
Joined
Feb 23, 2006
Messages
3,566
Hi
try the following macro. Keep C1 free.
Code:
Sub List_Unique()
d = 1
x = Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To x
c = "A1:A" & x
Cells(1, 3) = "=countif(" & c & ", A" & a & ")"
If Cells(1, 3) = 1 Then
Cells(d, 2) = Cells(a, 1)
d = d + 1
Else
End If
Next a
End Sub
If col A has the list, it will find unique values and lists them in col B.
Ravi
 

nelsok

Board Regular
Joined
Jan 20, 2006
Messages
166
im confused about how to use the code you have shown.

Why must c1 remain free if column a and b are being used.


Does this macro leave blank spaces where a duplicate value was removed?
 

ravishankar

Well-known Member
Joined
Feb 23, 2006
Messages
3,566
Hi
press Alt F11, Insert module and paste the above code and run the macro.
I have used C1 to calculate countif function. So it should be free. It does not remove duplicate values. It only lists items that are not duplicate.
Ravi
 

nelsok

Board Regular
Joined
Jan 20, 2006
Messages
166
so if i am understanding correctly:

1
1
2
3
3
4
5


would result in
2
4
5


is this correct?

if so I was trying to accomplish this:
1
2
3
4
5
where all unique values are show, duplicate entries removed but still accounted for.


Do you have a method for doing this?
 

ravishankar

Well-known Member
Joined
Feb 23, 2006
Messages
3,566
Hi
select the column, goto DATA menu, > Filter > Advanced filter > Click copy to another location > select the location (say C1) into "copy to" > click unique records only > click OK
Ravi
 

Yogi Anand

MrExcel MVP
Joined
Mar 12, 2002
Messages
11,454
Hi neslok:

Following is a formula based approach using UNIQUEVALUES function from MoreFunc Add-in ...
Book2
ABCDE
1UniqueValues
211
312
423
534
635
74 
85 
9
Sheet10


array formula in cell D2:D8 is ... =UNIQUEVALUES(B2:B8,1)
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
1) select vertical multiple cells
2) =Unique(A1:A10,1) 1 for non case sensitive, else case sensitive
3) confirm with Ctrl + Shift + Enter (Array formula)

Code:
Function UniqueOnly(rng As Range, CompareMode As Byte) As Variant
Dim r As Range
With CreateObject("Scripting.Dictionary")
     .CompareMode = IIf(CompareMode = 1, vbTextCompare, vbBinaryCompare)
     For Each r In rng
          If (r.Value <> "") * (Not .exists(r.Value) Then .add, Nothing
     Next
     UniqueOnly = WorksheetFunction.Transpose(.keys)
End With
End Function
 

nelsok

Board Regular
Joined
Jan 20, 2006
Messages
166
1) select vertical multiple cells
2) =Unique(A1:A10,1) 1 for non case sensitive, else case sensitive
3) confirm with Ctrl + Shift + Enter (Array formula)

Code:
Function UniqueOnly(rng As Range, CompareMode As Byte) As Variant
Dim r As Range
With CreateObject("Scripting.Dictionary")
     .CompareMode = IIf(CompareMode = 1, vbTextCompare, vbBinaryCompare)
     For Each r In rng
          If (r.Value <> "") * (Not .exists(r.Value) Then .add, Nothing
     Next
     UniqueOnly = WorksheetFunction.Transpose(.keys)
End With
End Function

when i try to run this function it says that there is a compile error: syntax error

and it turns the if statment red and the first line yellow. Any idea how to fix?
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Sorry, missed ")"

Code:
Function UniqueOnly(rng As Range, CompareMode As Byte) As Variant
Dim r As Range
With CreateObject("Scripting.Dictionary")
     .CompareMode = IIf(CompareMode = 1, vbTextCompare, vbBinaryCompare)
     For Each r In rng
          If (r.Value <> "") * (Not .exists(r.Value)) Then .add, Nothing
     Next
     UniqueOnly = WorksheetFunction.Transpose(.keys)
End With
End Function
 

Forum statistics

Threads
1,181,648
Messages
5,931,213
Members
436,784
Latest member
amuljono

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top