View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
mm_it_it mm_it_it is offline
external usenet poster
 
Posts: 3
Default Sorted range into collection

Hi Matt, your suggestion has been very helpful to me, thank you very much.
I changed your sub into a function (its what I needed from the beginning);
Im posting it below, hoping it could be useful to anyone.
Thanks a lot again.
Maurizio

Public Function getDistincValuesFromRange(strSelectedSheet As String,
strSelectedColumn As String) As Collection

Dim rngData As Range
Dim rngCell As Range
Dim colNoRepeats As New Collection
Dim lngJ As Long
Dim lngK As Long
Dim varCurr As Variant
Dim varNext As Variant
Dim varItem As Variant
Dim strStartCell As String
Dim strLastCellInColumn As String

'if you want all the values
'strStartCell = strSelectedColumn & "1"

'if you want all the values except the header
strStartCell = strSelectedColumn & "2"
strLastCellInColumn = strSelectedColumn & "65536"

Set rngData =
ActiveWorkbook.Sheets(strSelectedSheet).Range(strS tartCell,
Range(strLastCellInColumn).End(xlUp))

On Error Resume Next
For Each rngCell In rngData.Cells
colNoRepeats.Add Item:=rngCell.Value, Key:=CStr(rngCell.Value)
Next

On Error GoTo 0
For lngJ = 1 To colNoRepeats.Count - 1

For lngK = lngJ + 1 To colNoRepeats.Count

varCurr = colNoRepeats(lngJ)
varNext = colNoRepeats(lngK)

If varCurr = varNext Then
colNoRepeats.Add Item:=varCurr, Befo=lngK
colNoRepeats.Add Item:=varNext, Befo=lngJ
colNoRepeats.Remove lngJ + 1
colNoRepeats.Remove lngK + 1
End If

Next

Next

Set getDistincValuesFromRange = colNoRepeats

End Function



See below. This sub will work on the specified column data (which for
the purposes of the sub below is the data in column A). My first
learned this from J-Walk's website.

Best,

Matt Herbert

Sub CollectionOneColumn()

Dim rngData As Range
Dim rngCell As Range
Dim colNoRepeats As New Collection
Dim lngJ As Long
Dim lngK As Long
Dim varCurr As Variant
Dim varNext As Variant
Dim varItem As Variant

Set rngData = Range("a1", Cells(Columns("A").Cells.Count, 1).End
(xlUp))

On Error Resume Next
For Each rngCell In rngData.Cells
colNoRepeats.Add Item:=rngCell.Value, Key:=CStr(rngCell.Value)
Next
On Error GoTo 0

For lngJ = 1 To colNoRepeats.Count - 1
For lngK = lngJ + 1 To colNoRepeats.Count
varCurr = colNoRepeats(lngJ)
varNext = colNoRepeats(lngK)

If varCurr = varNext Then
colNoRepeats.Add Item:=varCurr, Befo=lngK
colNoRepeats.Add Item:=varNext, Befo=lngJ
colNoRepeats.Remove lngJ + 1
colNoRepeats.Remove lngK + 1
End If
Next
Next

For Each varItem In colNoRepeats
Debug.Print varItem
Next

End Sub