![]() |
unique values to array
what approach would i use to use look at values in a single filtered column and
populate an array with the unique numbers? -- Gary |
unique values to array
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. --- Regards, Norman |
unique values to array
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(xlCellType Visible) '<=====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 -- Jay "Gary Keramidas" wrote: what approach would i use to use look at values in a single filtered column and populate an array with the unique numbers? -- Gary |
unique values to array
thanks to you both, i'll give them a try
-- Gary "Norman Jones" wrote in message ... 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. --- Regards, Norman |
unique values to array
|
All times are GMT +1. The time now is 01:27 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com