Home |
Search |
Today's Posts |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
First Value in Sorted Column is Not Sorted Properly | Excel Discussion (Misc queries) | |||
Not sorted union range. | Excel Programming | |||
Link to a named range in another worksheet that is sorted frequent | Excel Worksheet Functions | |||
Insert rows into a sorted range | Excel Programming | |||
Range collection | Excel Programming |