Build List using Array of Unique Cell Values

[bdb1974]

Hi all,

I've been struggling all morning long trying to build a sort array code.
Arrays still have me flustered.

What I'd like to do is build a combobox list from the offsets of some cells within a Range having a specific value. There will be 3 conditions that need to be met before adding
to value to the combobox list. First condition, the value of cell within the range should equal the cell value in Cells(1,1). Secondly, the offset value should be unique.
Therefore no repeated values should be placed into the combobox list. And Third, which
is not really a condition, the built list should be sorted. Since the list will hold numerical
values, they should be listed from the smallest to the largest values.

I don't know if this can be of any use, but I thought maybe the array could be built
using the following with some substitutions.

Sub tst()
  sq = Filter([transpose(if(A1:A1000="","#",A1:A1000))], "#", False)
End Sub

source:
http://www.excelforum.com/excel-prog...mn-values.html

I believe that it's building an array based on any cell with a number)
I'm hoping it could be converted so that its based on a value in Cells(1,1)

I put together this:

  LastRow = Sheets(1).Cells.Find(what:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 sq = Filter([transpose(if (Sheets(1).Range("$B$7:$B$" & LastRow)="",Sheets(1).Range("A1").Value,Sheets(1).Range(A2:A1000).Offset(0,1)))], Sheets(1).Range("A1").Value, False)

If it can't be done in this manner then using:

  LastRow = Cells.Find(what:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

   For Each Cell In Sheets(1).Range("$B$7:$B$" & LastRow)
    If Trim(Cell.Value) = Sheet(1).Cells(1, 1).Value Then
' more code is needed to build array
sq () = Cell.Offset(0, 1).Value
next

x will be the element needing to be added to the array.
I'm hoping to avoid redimming or preserving the array through multiple loops.


However, once the array is built. then with

sq () as the array

I would then like to pass the array through a filter using a modified ver. of this function.

Private Function UniqueItemList(InputRange As Variant, _
    HorizontalList As Boolean) As Variant
Dim cl As Range, cUnique As New Collection, I As Long, uList() As Variant
    Application.Volatile
    On Error Resume Next
    For Each cl In InputRange
        If cl.Formula <> "" Then
            cUnique.Add cl.Value, CStr(cl.Value)
        End If
    Next cl
    UniqueItemList = ""
    If cUnique.Count > 0 Then
        ReDim uList(1 To cUnique.Count)
        For I = 1 To cUnique.Count
            uList(I) = cUnique(I)
        Next I
        UniqueItemList = uList
        If Not HorizontalList Then
            UniqueItemList = _
                Application.WorksheetFunction.Transpose(UniqueItemList)
        End If
    End If
    On Error GoTo 0
End Function

The function needs to able to accept the built array.

It should be run through the function by doing something like

Dim MyUniqueList As Variant, I As Long
   With UserForm1.ListBox1
    .Clear
   MyUniqueList = UniqueItemList(sq, True)
For I = 2 To UBound(MyUniqueList)
            .AddItem MyUniqueList(I)
        Next I
        .ListIndex = 0 ' select the first item
 
   UserForm1.Show

Hopefully someone with more experience than I can following my logic and help me
with building a working script.

Thanks,

BDB

[snb]

I'm not sure I understand what you mean with 'offset'.

Maybe:

Sub tst()
  sq = Filter([transpose(if(A1:A1000=A1,B1:B1000),"#"))], "#", False)
End Sub

to 'uniquize' the array:

Sub tst()
  sq = Filter([transpose(if(A1:A1000=A1,B1:B1000),"#"))], "#", False)
  do
     c01=c01 & sq(0) & vbcr
     sq=filter(sq,sq(0),false)
  loop until ubound(sq)=-1
  sq=split(c01,vbcr)
End Sub

[bdb1974]

Actually I want to filter using a dynamic range where A1:A & Lastrow is used instead of A1:A1000.
But I have not gotten that to workthe filter.

It should filter so the built array values/elements will be the Cell.offsets (0,1) of each
cell whose value is equal Cells(1,1)

HTH's.

I've run out of time for today. I will have to continue with this problem tomorrow

Thanks,

BDB