View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
klysell klysell is offline
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