Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Unique values from list of many values (with duplicates)
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 146
Default Unique values from list of many values (with duplicates)
Hi,

In setting up a unique list of codes, I used a one formula
"=IF(COUNTIF(MasterData!$K$2:I4,MasterData!I4)=1,M asterData!I4,"") "
in an adjacent column relative to the original list. This gave me my unique
values, but it left blanks in between unique values.

I then used an array formula
"{=NOBLANKS_1(L2:L20000)} "
coupled with VBA code to get rid of the blanks. Here's the VBA code:

Option Explicit
Option Compare Text

Function NoBlanks_1(ITBGrp_Range1 As Range) As Variant()
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 (ITBGrp_Range1.Rows.Count 1) And _
(ITBGrp_Range1.Columns.Count 1) Then

ReDim Result(1 To ITBGrp_Range1.Rows.Count, 1 To
ITBGrp_Range1.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_1 = Result
Exit Function
End If

If (Application.Caller.Rows.Count 1) And _
(Application.Caller.Columns.Count 1) Then

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_1 = Result
Exit Function
End If

MaxCells = Application.WorksheetFunction.Max( _
Application.Caller.Cells.Count, ITBGrp_Range1.Cells.Count)

ReDim Result(1 To MaxCells, 1 To 1)

For Each Rng In ITBGrp_Range1.Cells
If Rng.Value < vbNullString Then
N = N + 1
Result(N, 1) = Rng.Value
End If
Next Rng

For N2 = N + 1 To MaxCells
Result(N2, 1) = vbNullString
Next N2

If Application.Caller.Rows.Count = 1 Then
NoBlanks_1 = Application.Transpose(Result)
Else
NoBlanks_1 = Result
End If
End Function


It's made my worksheet rather unwieldy... can anyone suggest a more
efficient method? Thanks.
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default Unique values from list of many values (with duplicates)
You can get a unique list by selecting the column and doing

Data=Filter=Advanced Filter

Make sure the top box reflects your data source (single column)
Leave Criteria blank
Check copy to another location
and Select a cell for the output.

in the lower Left select Unique checkbox

Click OK.

To this with the macro recorder and you will get a one line command that
will give you the list of unique values.

Worksheets("Data").Range("A1:A1000").AdvancedFilte r _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Data").Range("C1"), _
Unique:=True

The copytoRange can be on another sheet when you do this with code.

--
Regards,
Tom Ogilvy


"klysell" wrote:

Hi,

In setting up a unique list of codes, I used a one formula
"=IF(COUNTIF(MasterData!$K$2:I4,MasterData!I4)=1,M asterData!I4,"") "
in an adjacent column relative to the original list. This gave me my unique
values, but it left blanks in between unique values.

I then used an array formula
"{=NOBLANKS_1(L2:L20000)} "
coupled with VBA code to get rid of the blanks. Here's the VBA code:

Option Explicit
Option Compare Text

Function NoBlanks_1(ITBGrp_Range1 As Range) As Variant()
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 (ITBGrp_Range1.Rows.Count 1) And _
(ITBGrp_Range1.Columns.Count 1) Then

ReDim Result(1 To ITBGrp_Range1.Rows.Count, 1 To
ITBGrp_Range1.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_1 = Result
Exit Function
End If

If (Application.Caller.Rows.Count 1) And _
(Application.Caller.Columns.Count 1) Then

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_1 = Result
Exit Function
End If

MaxCells = Application.WorksheetFunction.Max( _
Application.Caller.Cells.Count, ITBGrp_Range1.Cells.Count)

ReDim Result(1 To MaxCells, 1 To 1)

For Each Rng In ITBGrp_Range1.Cells
If Rng.Value < vbNullString Then
N = N + 1
Result(N, 1) = Rng.Value
End If
Next Rng

For N2 = N + 1 To MaxCells
Result(N2, 1) = vbNullString
Next N2

If Application.Caller.Rows.Count = 1 Then
NoBlanks_1 = Application.Transpose(Result)
Else
NoBlanks_1 = Result
End If
End Function


It's made my worksheet rather unwieldy... can anyone suggest a more
efficient method? Thanks.
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 146
Default Unique values from list of many values (with duplicates)
Thanks very much Tom.
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557


"Tom Ogilvy" wrote:

You can get a unique list by selecting the column and doing

Data=Filter=Advanced Filter

Make sure the top box reflects your data source (single column)
Leave Criteria blank
Check copy to another location
and Select a cell for the output.

in the lower Left select Unique checkbox

Click OK.

To this with the macro recorder and you will get a one line command that
will give you the list of unique values.

Worksheets("Data").Range("A1:A1000").AdvancedFilte r _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Data").Range("C1"), _
Unique:=True

The copytoRange can be on another sheet when you do this with code.

--
Regards,
Tom Ogilvy


"klysell" wrote:

Hi,

In setting up a unique list of codes, I used a one formula
"=IF(COUNTIF(MasterData!$K$2:I4,MasterData!I4)=1,M asterData!I4,"") "
in an adjacent column relative to the original list. This gave me my unique
values, but it left blanks in between unique values.

I then used an array formula
"{=NOBLANKS_1(L2:L20000)} "
coupled with VBA code to get rid of the blanks. Here's the VBA code:

Option Explicit
Option Compare Text

Function NoBlanks_1(ITBGrp_Range1 As Range) As Variant()
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 (ITBGrp_Range1.Rows.Count 1) And _
(ITBGrp_Range1.Columns.Count 1) Then

ReDim Result(1 To ITBGrp_Range1.Rows.Count, 1 To
ITBGrp_Range1.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_1 = Result
Exit Function
End If

If (Application.Caller.Rows.Count 1) And _
(Application.Caller.Columns.Count 1) Then

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_1 = Result
Exit Function
End If

MaxCells = Application.WorksheetFunction.Max( _
Application.Caller.Cells.Count, ITBGrp_Range1.Cells.Count)

ReDim Result(1 To MaxCells, 1 To 1)

For Each Rng In ITBGrp_Range1.Cells
If Rng.Value < vbNullString Then
N = N + 1
Result(N, 1) = Rng.Value
End If
Next Rng

For N2 = N + 1 To MaxCells
Result(N2, 1) = vbNullString
Next N2

If Application.Caller.Rows.Count = 1 Then
NoBlanks_1 = Application.Transpose(Result)
Else
NoBlanks_1 = Result
End If
End Function


It's made my worksheet rather unwieldy... can anyone suggest a more
efficient method? Thanks.
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 146
Default Unique values from list of many values (with duplicates)
Hi Tom,

It doesn't seem to work on the ITBGrp list since the first 8 items are blank
with only values showing up at the eight row. It does seem to work fine on
the IO_Grp list since the first cell in the range has a value. Could this be
a bug in the advanced filter tool? I'll keep testing it.

Thanks,
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557


"Tom Ogilvy" wrote:

You can get a unique list by selecting the column and doing

Data=Filter=Advanced Filter

Make sure the top box reflects your data source (single column)
Leave Criteria blank
Check copy to another location
and Select a cell for the output.

in the lower Left select Unique checkbox

Click OK.

To this with the macro recorder and you will get a one line command that
will give you the list of unique values.

Worksheets("Data").Range("A1:A1000").AdvancedFilte r _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Data").Range("C1"), _
Unique:=True

The copytoRange can be on another sheet when you do this with code.

--
Regards,
Tom Ogilvy


"klysell" wrote:

Hi,

In setting up a unique list of codes, I used a one formula
"=IF(COUNTIF(MasterData!$K$2:I4,MasterData!I4)=1,M asterData!I4,"") "
in an adjacent column relative to the original list. This gave me my unique
values, but it left blanks in between unique values.

I then used an array formula
"{=NOBLANKS_1(L2:L20000)} "
coupled with VBA code to get rid of the blanks. Here's the VBA code:

Option Explicit
Option Compare Text

Function NoBlanks_1(ITBGrp_Range1 As Range) As Variant()
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 (ITBGrp_Range1.Rows.Count 1) And _
(ITBGrp_Range1.Columns.Count 1) Then

ReDim Result(1 To ITBGrp_Range1.Rows.Count, 1 To
ITBGrp_Range1.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_1 = Result
Exit Function
End If

If (Application.Caller.Rows.Count 1) And _
(Application.Caller.Columns.Count 1) Then

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_1 = Result
Exit Function
End If

MaxCells = Application.WorksheetFunction.Max( _
Application.Caller.Cells.Count, ITBGrp_Range1.Cells.Count)

ReDim Result(1 To MaxCells, 1 To 1)

For Each Rng In ITBGrp_Range1.Cells
If Rng.Value < vbNullString Then
N = N + 1
Result(N, 1) = Rng.Value
End If
Next Rng

For N2 = N + 1 To MaxCells
Result(N2, 1) = vbNullString
Next N2

If Application.Caller.Rows.Count = 1 Then
NoBlanks_1 = Application.Transpose(Result)
Else
NoBlanks_1 = Result
End If
End Function


It's made my worksheet rather unwieldy... can anyone suggest a more
efficient method? Thanks.
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 146
Default Unique values from list of many values (with duplicates)
It would seem that I would need a pre-emptive column that would remove all
the blanks from the source column; then I could use the advanced filter
tool... What are your thoughts? TIA,

K

--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557


"klysell" wrote:

Hi Tom,

It doesn't seem to work on the ITBGrp list since the first 8 items are blank
with only values showing up at the eight row. It does seem to work fine on
the IO_Grp list since the first cell in the range has a value. Could this be
a bug in the advanced filter tool? I'll keep testing it.

Thanks,
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557


"Tom Ogilvy" wrote:

You can get a unique list by selecting the column and doing

Data=Filter=Advanced Filter

Make sure the top box reflects your data source (single column)
Leave Criteria blank
Check copy to another location
and Select a cell for the output.

in the lower Left select Unique checkbox

Click OK.

To this with the macro recorder and you will get a one line command that
will give you the list of unique values.

Worksheets("Data").Range("A1:A1000").AdvancedFilte r _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Data").Range("C1"), _
Unique:=True

The copytoRange can be on another sheet when you do this with code.

--
Regards,
Tom Ogilvy


"klysell" wrote:

Hi,

In setting up a unique list of codes, I used a one formula
"=IF(COUNTIF(MasterData!$K$2:I4,MasterData!I4)=1,M asterData!I4,"") "
in an adjacent column relative to the original list. This gave me my unique
values, but it left blanks in between unique values.

I then used an array formula
"{=NOBLANKS_1(L2:L20000)} "
coupled with VBA code to get rid of the blanks. Here's the VBA code:

Option Explicit
Option Compare Text

Function NoBlanks_1(ITBGrp_Range1 As Range) As Variant()
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 (ITBGrp_Range1.Rows.Count 1) And _
(ITBGrp_Range1.Columns.Count 1) Then

ReDim Result(1 To ITBGrp_Range1.Rows.Count, 1 To
ITBGrp_Range1.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_1 = Result
Exit Function
End If

If (Application.Caller.Rows.Count 1) And _
(Application.Caller.Columns.Count 1) Then

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_1 = Result
Exit Function
End If

MaxCells = Application.WorksheetFunction.Max( _
Application.Caller.Cells.Count, ITBGrp_Range1.Cells.Count)

ReDim Result(1 To MaxCells, 1 To 1)

For Each Rng In ITBGrp_Range1.Cells
If Rng.Value < vbNullString Then
N = N + 1
Result(N, 1) = Rng.Value
End If
Next Rng

For N2 = N + 1 To MaxCells
Result(N2, 1) = vbNullString
Next N2

If Application.Caller.Rows.Count = 1 Then
NoBlanks_1 = Application.Transpose(Result)
Else
NoBlanks_1 = Result
End If
End Function


It's made my worksheet rather unwieldy... can anyone suggest a more
efficient method? Thanks.
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 6,953
Default Unique values from list of many values (with duplicates)
I ran this on a column filled with randomly occuring blanks and blocks of
blanks in the range I specifice (M1:M101)

Sub EFG()
ActiveSheet.Range("M1:M101").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=ActiveSheet.Range("O1"), _
Unique:=True

End Sub

IT worked fine for me. The results included a single blank cell because
there are blanks in the data, so that is a unique value - however I could
easily add a line of code to remove that.

Your data was dirty to me. You have cells which look blank, but apparently
contain a null string in them because they are not really empty. You need to
clean up your data and life will be easier.

--
Regards,
Tom Ogilvy



"klysell" wrote:

It would seem that I would need a pre-emptive column that would remove all
the blanks from the source column; then I could use the advanced filter
tool... What are your thoughts? TIA,

K

--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557


"klysell" wrote:

Hi Tom,

It doesn't seem to work on the ITBGrp list since the first 8 items are blank
with only values showing up at the eight row. It does seem to work fine on
the IO_Grp list since the first cell in the range has a value. Could this be
a bug in the advanced filter tool? I'll keep testing it.

Thanks,
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557


"Tom Ogilvy" wrote:

You can get a unique list by selecting the column and doing

Data=Filter=Advanced Filter

Make sure the top box reflects your data source (single column)
Leave Criteria blank
Check copy to another location
and Select a cell for the output.

in the lower Left select Unique checkbox

Click OK.

To this with the macro recorder and you will get a one line command that
will give you the list of unique values.

Worksheets("Data").Range("A1:A1000").AdvancedFilte r _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Data").Range("C1"), _
Unique:=True

The copytoRange can be on another sheet when you do this with code.

--
Regards,
Tom Ogilvy


"klysell" wrote:

Hi,

In setting up a unique list of codes, I used a one formula
"=IF(COUNTIF(MasterData!$K$2:I4,MasterData!I4)=1,M asterData!I4,"") "
in an adjacent column relative to the original list. This gave me my unique
values, but it left blanks in between unique values.

I then used an array formula
"{=NOBLANKS_1(L2:L20000)} "
coupled with VBA code to get rid of the blanks. Here's the VBA code:

Option Explicit
Option Compare Text

Function NoBlanks_1(ITBGrp_Range1 As Range) As Variant()
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 (ITBGrp_Range1.Rows.Count 1) And _
(ITBGrp_Range1.Columns.Count 1) Then

ReDim Result(1 To ITBGrp_Range1.Rows.Count, 1 To
ITBGrp_Range1.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_1 = Result
Exit Function
End If

If (Application.Caller.Rows.Count 1) And _
(Application.Caller.Columns.Count 1) Then

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_1 = Result
Exit Function
End If

MaxCells = Application.WorksheetFunction.Max( _
Application.Caller.Cells.Count, ITBGrp_Range1.Cells.Count)

ReDim Result(1 To MaxCells, 1 To 1)

For Each Rng In ITBGrp_Range1.Cells
If Rng.Value < vbNullString Then
N = N + 1
Result(N, 1) = Rng.Value
End If
Next Rng

For N2 = N + 1 To MaxCells
Result(N2, 1) = vbNullString
Next N2

If Application.Caller.Rows.Count = 1 Then
NoBlanks_1 = Application.Transpose(Result)
Else
NoBlanks_1 = Result
End If
End Function


It's made my worksheet rather unwieldy... can anyone suggest a more
efficient method? Thanks.
--
Kent Lysell
Financial Consultant
Ottawa, Ontario
W: 613.948-9557
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Duplicates and unique values sragor Excel Worksheet Functions 1 February 3rd 09 08:22 AM
Identifying unique values among duplicates bob Excel Worksheet Functions 4 November 10th 08 09:43 PM
check for duplicates, then sum unique values Weissme Excel Discussion (Misc queries) 0 August 9th 06 04:35 PM
Count unique values and create list based on these values vipa2000 Excel Worksheet Functions 7 August 5th 05 01:17 AM
create list of unique values from a column with repeated values? Chad Schaben Excel Worksheet Functions 1 July 8th 05 10:25 PM


All times are GMT +1. The time now is 04:12 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement