Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorted range into collection
Hi everyone,
I'm working with excel 2003 and I'm developing a custom interface to automatize some operations. I'm using the MS office VB editor. I can't use .net framework. I need to: - take the values contained in an excel column - sort values alphabetically - remove duplicate values - put the values in a collection. I need to do everything "on the code side", cell values on the sheet cannot be modified. The requisite of the collection is not mandatory, any similar object would be useful. I did many test but none of them works. Thanks in advance to everybody -- Nobody expects the Spanish Inquisition! Our chief weapon is surprise...surprise and fear...fear and surprise.... Our two weapons are fear and surprise... |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorted range into collection
Sub Macro1()
Dim lLastRow As Long Dim lLastCol As Long Dim i As Long Dim j As Long Dim k As Long Cells.Select Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Select lLastRow = ActiveSheet.UsedRange.Rows.Count - 1 lLastCol = ActiveSheet.UsedRange.Columns.Count - 1 For i = 0 To lLastRow - 1 For j = lLastRow To i + 1 Step -1 For k = 0 To lLastCol If ActiveSheet.Range("A1").Offset(i, k).Value < ActiveSheet.Range("A1").Offset(j, k).Value Then Exit For End If Next k If k lLastCol Then ActiveSheet.Range("A1").Offset(j, 0).EntireRow.Delete End If Next j Next i End Sub Before you run this code, make a backup of your data in case it does something you don't expect!! HTH, Ryan--- -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "mm_it_it" wrote: Hi everyone, I'm working with excel 2003 and I'm developing a custom interface to automatize some operations. I'm using the MS office VB editor. I can't use .net framework. I need to: - take the values contained in an excel column - sort values alphabetically - remove duplicate values - put the values in a collection. I need to do everything "on the code side", cell values on the sheet cannot be modified. The requisite of the collection is not mandatory, any similar object would be useful. I did many test but none of them works. Thanks in advance to everybody -- Nobody expects the Spanish Inquisition! Our chief weapon is surprise...surprise and fear...fear and surprise.... Our two weapons are fear and surprise... |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorted range into collection
Maybe I wrote something that is almost right:
Public Function getDistincValuesFromRange(rangeValue As String) As Collection Dim tmpCollection As Collection Set tmpCollection = New Collection Dim tmpRange As Range Dim tmpCell As Variant 'Set tmpRange = ActiveWorkbook.Sheets("DataSheet").Range("A:A") Set tmpRange = ActiveWorkbook.Sheets("DataSheet").Range(rangeValu e) For Each tmpCell In tmpRange On Error Resume Next tmpCollection.Add tmpCell.Value, tmpCell.Value Next tmpCollection.Sort Key1:="Key" End Function Unfortunately I'm still having problems with the last instruction, it doesn't sort the collection, but it neither raise any error ... Is it the way I use the sort method? Thanks again -- Nobody expects the Spanish Inquisition! Our chief weapon is surprise...surprise and fear...fear and surprise.... Our two weapons are fear and surprise... "mm_it_it" wrote: Hi everyone, I'm working with excel 2003 and I'm developing a custom interface to automatize some operations. I'm using the MS office VB editor. I can't use .net framework. I need to: - take the values contained in an excel column - sort values alphabetically - remove duplicate values - put the values in a collection. I need to do everything "on the code side", cell values on the sheet cannot be modified. The requisite of the collection is not mandatory, any similar object would be useful. I did many test but none of them works. Thanks in advance to everybody -- Nobody expects the Spanish Inquisition! Our chief weapon is surprise...surprise and fear...fear and surprise.... Our two weapons are fear and surprise... |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorted range into collection
On Mar 21, 4:23*pm, ryguy7272
wrote: Sub Macro1() Dim lLastRow As Long Dim lLastCol As Long Dim i As Long Dim j As Long Dim k As Long * * Cells.Select * * Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ * * * * OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ * * * * DataOption1:=xlSortNormal Range("A1").Select lLastRow = ActiveSheet.UsedRange.Rows.Count - 1 lLastCol = ActiveSheet.UsedRange.Columns.Count - 1 * For i = 0 To lLastRow - 1 * * For j = lLastRow To i + 1 Step -1 * * * For k = 0 To lLastCol * * * * If ActiveSheet.Range("A1").Offset(i, k).Value < ActiveSheet.Range("A1").Offset(j, k).Value Then * * * * * Exit For * * * * End If * * * Next k * * * If k lLastCol Then * * * * ActiveSheet.Range("A1").Offset(j, 0).EntireRow.Delete * * * End If * * Next j * Next i End Sub Before you run this code, make a backup of your data in case it does something you don't expect!! HTH, Ryan--- -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''.. "mm_it_it" wrote: Hi everyone, * * I'm working with excel 2003 and I'm developing a custom interface to automatize some operations. I'm using the MS office VB editor. I can't use .net framework. I need to: *- take the values contained in an excel column *- sort values alphabetically *- remove duplicate values *- put the values in a collection. I need to do everything "on the code side", cell values on the sheet cannot be modified. The requisite of the collection is not mandatory, any similar object would be useful. I did many test but none of them works. Thanks in advance to everybody -- Nobody expects the Spanish Inquisition! Our chief weapon is surprise...surprise and fear...fear and surprise.... Our two weapons are fear and surprise...- Hide quoted text - - Show quoted text - 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
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 |