unique values to array

[Gary Keramidas]

what approach would i use to use look at values in a single filtered column and
populate an array with the unique numbers?

 

[Norman Jones]

Hi Gary,

'---------------------
what approach would i use to use look at values in a single
filtered column and populate an array with the unique numbers?
'---------------------

Try something like:
'================>>
Public Sub Tester002()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim Rng2 As Range
Dim rCell As Range
Dim myCol As Collection
Dim Arr() As Variant
Dim i As Long

Set WB = ActiveWorkbook '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE
Set Rng = SH.AutoFilter.Range '<<===== CHANGE

If Not Rng Is Nothing Then
Set Rng2 = Rng.Columns(1) '<<===== CHANGE
End If

Set Rng2 = Rng2.Offset(1).Resize(Rng2.Rows.Count - 1)
Set Rng2 = Rng2.SpecialCells(xlCellTypeVisible)

Set myCol = New Collection
On Error Resume Next
For Each rCell In Rng2.Cells
With rCell
myCol.Add .Value, CStr(.Value)
End With
Next rCell
On Error GoTo 0

'Do something with the stored unique vales, e.g.:
ReDim Arr(1 To myCol.Count)
For i = 1 To myCol.Count
Debug.Print myCol(i)
'Optionally, load an array:
Arr(i) = myCol(1)
Next i
End Sub
'<<================

Subject to your requirements, the collection may render use of an array
superfluous.

 

[Guest]

Hi Gary -

Below is my suggestion. I like Norman's better because he minimized index
use; always a good idea. Whatever works for you.

PS: In the 3rd line from the end of Norman's procedure, the "1" in the
'mycol(1)' term should be changed to the letter 'i'.

Sub gary()
Dim visibleRange As Range
Dim uniqueValues() As Single

With Worksheets("Sheet1").Range("A1") '<=====Modify to suit
Set visibleRange =
..CurrentRegion.Columns(1).SpecialCells(xlCellTypeVisible) '<=====Modify Col#
to suit
End With

i = 0: redimIndex = 1
For Each c In visibleRange
i = i + 1
If i > 1 And i <= 2 Then 'Skip the field name value and store first
value (always unique) as first array element
ReDim uniqueValues(1)
uniqueValues(1) = c.Value
ElseIf i > 2 Then 'Test each subsequent value against existing unique
values
Unique = True
For ir = 1 To redimIndex
If c.Value = uniqueValues(ir) Then Unique = False
Next ir
If Unique Then
redimIndex = redimIndex + 1
ReDim Preserve uniqueValues(redimIndex)
uniqueValues(redimIndex) = c.Value
End If
End If
Next 'c

'----------------------------------------------------
'Print unique values to Immediate window
'----------------------------------------------------
For i = 1 To redimIndex
Debug.Print uniqueValues(i)
Next i
MsgBox "There are " & redimIndex & " unique elements in the array
'uniqueValues'." & Chr(13) & Chr(13) & _
"To see the values, switch to the Visual Basic Editor and press
Ctrl-G."

End Sub

 

[Gary Keramidas]

thanks to you both, i'll give them a try

 

[bplumhoff]

Hello,

One possible approach:
http://www.sulprobil.com/html/listfreq.html

HTH,
Bernd