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

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

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

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

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

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