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