Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Is a Collection the best option?
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 413
Default Is a Collection the best option?
Many thanks to you both.

I was trying to use a Collection because I thought I had
read somewhere about it automatically excluding any
duplicates.........sure enough that link to J. W.'s site
confirms this (hence the use of OERN to suppress any
messages).

I imported Tom's code:

However, when I ran the code on my test sheets, it did
not exclude duplicates. Is it worth pursuing (out of
interest) the Collection idea, or perhaps follow the array
route?

Regards.

"Tom Ogilvy" wrote in message
...
I believe it does work (at least it did for me), but you can't see the
result with

msgbox EnquiryList

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value
End If
Next Cell
On Error GoTo 0
End With
Next
sStr = ""
For Each itm In EnquiryList
sStr = sStr & itm & vbNewLine
Next
msgbox sStr
End Sub


See John Walkenbach's site for an example to follow including sorting

http://j-walk.com/ss/excel/tips/tip47.htm

--
Regards,
Tom Ogilvy








Stuart wrote in message
...
I'm looking to take unique values from a defined range
into a form. The values will be alphabetic characters.
Here is what I have so far:

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value
End If
Next Cell
On Error GoTo 0
End With
Next

MsgBox EnquiryList

End Sub

Why is it that when the code loops into the 2nd sheet, any
unique values in that sheet's DataRange are not added to the
Collection, please?

Regards.





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default Is a Collection the best option?
Stick with the collection. To get the Uniques (my oversight), you need to
add a key value:

Change
EnquiryList.Add Cell.Value
to
EnquiryList.Add Cell.Value, cstr(cell.Value)

I also missed the correction which solved your immediate question:

Set DataRange = Range("H2", "J" & LastRow)

does not have a period (full stop) in front of range and thus refers to the
active sheet, so change it to

Set DataRange = .Range("H2", "J" & LastRow)

so that is why you were not getting the values from the second sheet.

Here is a revision that uses John's sort to produce a sorted list of
uniques:

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = .Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value, CStr(Cell.Value)
End If
Next Cell
On Error GoTo 0
End With
Next


For i = 1 To EnquiryList.Count - 1
For j = i + 1 To EnquiryList.Count
If EnquiryList(i) EnquiryList(j) Then
Swap1 = EnquiryList(i)
Swap2 = EnquiryList(j)
EnquiryList.Add Swap1, befo=j
EnquiryList.Add Swap2, befo=i
EnquiryList.Remove i + 1
EnquiryList.Remove j + 1
End If
Next j
Next i

For Each itm In EnquiryList
Debug.Print itm
Next
End Sub

You can use arrays if you want, but the above works fine.

--
Regards,
Tom Ogilvy



Stuart wrote in message
...
Many thanks to you both.

I was trying to use a Collection because I thought I had
read somewhere about it automatically excluding any
duplicates.........sure enough that link to J. W.'s site
confirms this (hence the use of OERN to suppress any
messages).

I imported Tom's code:

However, when I ran the code on my test sheets, it did
not exclude duplicates. Is it worth pursuing (out of
interest) the Collection idea, or perhaps follow the array
route?

Regards.

"Tom Ogilvy" wrote in message
...
I believe it does work (at least it did for me), but you can't see the
result with

msgbox EnquiryList

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value
End If
Next Cell
On Error GoTo 0
End With
Next
sStr = ""
For Each itm In EnquiryList
sStr = sStr & itm & vbNewLine
Next
msgbox sStr
End Sub


See John Walkenbach's site for an example to follow including sorting

http://j-walk.com/ss/excel/tips/tip47.htm

--
Regards,
Tom Ogilvy








Stuart wrote in message
...
I'm looking to take unique values from a defined range
into a form. The values will be alphabetic characters.
Here is what I have so far:

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value
End If
Next Cell
On Error GoTo 0
End With
Next

MsgBox EnquiryList

End Sub

Why is it that when the code loops into the 2nd sheet, any
unique values in that sheet's DataRange are not added to the
Collection, please?

Regards.





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003




Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 413
Default Is a Collection the best option?
Many thanks, and JW's sort is useful too.

Two final questions, please:

I've been trying to find a way to test the data
so as to be sure it's a single alphabetic character
(case doesn't matter):

For Each Cell In DataRange
If Not IsEmpty(Cell) Then
If Cell.Value isText And is a single character Then
do Tom's code
Else 'skip it

And

does the use of "If Not IsEmpty(Cell) Then"
actually speed the code execution in this situation?

Regards.

"Tom Ogilvy" wrote in message
...
Stick with the collection. To get the Uniques (my oversight), you need to
add a key value:

Change
EnquiryList.Add Cell.Value
to
EnquiryList.Add Cell.Value, cstr(cell.Value)

I also missed the correction which solved your immediate question:

Set DataRange = Range("H2", "J" & LastRow)

does not have a period (full stop) in front of range and thus refers to
the
active sheet, so change it to

Set DataRange = .Range("H2", "J" & LastRow)

so that is why you were not getting the values from the second sheet.

Here is a revision that uses John's sort to produce a sorted list of
uniques:

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = .Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value, CStr(Cell.Value)
End If
Next Cell
On Error GoTo 0
End With
Next


For i = 1 To EnquiryList.Count - 1
For j = i + 1 To EnquiryList.Count
If EnquiryList(i) EnquiryList(j) Then
Swap1 = EnquiryList(i)
Swap2 = EnquiryList(j)
EnquiryList.Add Swap1, befo=j
EnquiryList.Add Swap2, befo=i
EnquiryList.Remove i + 1
EnquiryList.Remove j + 1
End If
Next j
Next i

For Each itm In EnquiryList
Debug.Print itm
Next
End Sub

You can use arrays if you want, but the above works fine.

--
Regards,
Tom Ogilvy




---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default Is a Collection the best option?
If Not isempty(Cell)
is preventative - prevents adding a null string to the collection.

if you want to reduce the number of cells checked:

On error resume next
Set DataRange = .Range("H2", "J" & LastRow). _
SpecialCells(xlConstants,xlTextValues)
On error goto 0
if DataRange is Nothing then Exit sub

Of course, that would exclude numbers -


Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = .Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
if len(Cell.Value) = 1 then
EnquiryList.Add Cell.Value, CStr(Cell.Value)
end if
End If
Next Cell
On Error GoTo 0
End With
Next


For i = 1 To EnquiryList.Count - 1
For j = i + 1 To EnquiryList.Count
If EnquiryList(i) EnquiryList(j) Then
Swap1 = EnquiryList(i)
Swap2 = EnquiryList(j)
EnquiryList.Add Swap1, befo=j
EnquiryList.Add Swap2, befo=i
EnquiryList.Remove i + 1
EnquiryList.Remove j + 1
End If
Next j
Next i

For Each itm In EnquiryList
Debug.Print itm
Next
End Sub
Stuart wrote in message
...
Many thanks, and JW's sort is useful too.

Two final questions, please:

I've been trying to find a way to test the data
so as to be sure it's a single alphabetic character
(case doesn't matter):

For Each Cell In DataRange
If Not IsEmpty(Cell) Then
If Cell.Value isText And is a single character Then
do Tom's code
Else 'skip it

And

does the use of "If Not IsEmpty(Cell) Then"
actually speed the code execution in this situation?

Regards.

"Tom Ogilvy" wrote in message
...
Stick with the collection. To get the Uniques (my oversight), you need
to
add a key value:

Change
EnquiryList.Add Cell.Value
to
EnquiryList.Add Cell.Value, cstr(cell.Value)

I also missed the correction which solved your immediate question:

Set DataRange = Range("H2", "J" & LastRow)

does not have a period (full stop) in front of range and thus refers to
the
active sheet, so change it to

Set DataRange = .Range("H2", "J" & LastRow)

so that is why you were not getting the values from the second sheet.

Here is a revision that uses John's sort to produce a sorted list of
uniques:

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = .Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value, CStr(Cell.Value)
End If
Next Cell
On Error GoTo 0
End With
Next


For i = 1 To EnquiryList.Count - 1
For j = i + 1 To EnquiryList.Count
If EnquiryList(i) EnquiryList(j) Then
Swap1 = EnquiryList(i)
Swap2 = EnquiryList(j)
EnquiryList.Add Swap1, befo=j
EnquiryList.Add Swap2, befo=i
EnquiryList.Remove i + 1
EnquiryList.Remove j + 1
End If
Next j
Next i

For Each itm In EnquiryList
Debug.Print itm
Next
End Sub

You can use arrays if you want, but the above works fine.

--
Regards,
Tom Ogilvy




---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003




Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 413
Default Is a Collection the best option?
Many thanks.

Regards.

"Tom Ogilvy" wrote in message
...
If Not isempty(Cell)
is preventative - prevents adding a null string to the collection.

if you want to reduce the number of cells checked:

On error resume next
Set DataRange = .Range("H2", "J" & LastRow). _
SpecialCells(xlConstants,xlTextValues)
On error goto 0
if DataRange is Nothing then Exit sub

Of course, that would exclude numbers -


Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = .Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
if len(Cell.Value) = 1 then
EnquiryList.Add Cell.Value, CStr(Cell.Value)
end if
End If
Next Cell
On Error GoTo 0
End With
Next


For i = 1 To EnquiryList.Count - 1
For j = i + 1 To EnquiryList.Count
If EnquiryList(i) EnquiryList(j) Then
Swap1 = EnquiryList(i)
Swap2 = EnquiryList(j)
EnquiryList.Add Swap1, befo=j
EnquiryList.Add Swap2, befo=i
EnquiryList.Remove i + 1
EnquiryList.Remove j + 1
End If
Next j
Next i

For Each itm In EnquiryList
Debug.Print itm
Next
End Sub
Stuart wrote in message
...
Many thanks, and JW's sort is useful too.

Two final questions, please:

I've been trying to find a way to test the data
so as to be sure it's a single alphabetic character
(case doesn't matter):

For Each Cell In DataRange
If Not IsEmpty(Cell) Then
If Cell.Value isText And is a single character Then
do Tom's code
Else 'skip it

And

does the use of "If Not IsEmpty(Cell) Then"
actually speed the code execution in this situation?

Regards.

"Tom Ogilvy" wrote in message
...
Stick with the collection. To get the Uniques (my oversight), you
need
to
add a key value:

Change
EnquiryList.Add Cell.Value
to
EnquiryList.Add Cell.Value, cstr(cell.Value)

I also missed the correction which solved your immediate question:

Set DataRange = Range("H2", "J" & LastRow)

does not have a period (full stop) in front of range and thus refers
to
the
active sheet, so change it to

Set DataRange = .Range("H2", "J" & LastRow)

so that is why you were not getting the values from the second sheet.

Here is a revision that uses John's sort to produce a sorted list of
uniques:

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = .Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value, CStr(Cell.Value)
End If
Next Cell
On Error GoTo 0
End With
Next


For i = 1 To EnquiryList.Count - 1
For j = i + 1 To EnquiryList.Count
If EnquiryList(i) EnquiryList(j) Then
Swap1 = EnquiryList(i)
Swap2 = EnquiryList(j)
EnquiryList.Add Swap1, befo=j
EnquiryList.Add Swap2, befo=i
EnquiryList.Remove i + 1
EnquiryList.Remove j + 1
End If
Next j
Next i

For Each itm In EnquiryList
Debug.Print itm
Next
End Sub

You can use arrays if you want, but the above works fine.

--
Regards,
Tom Ogilvy




---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003


Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 23
Default Is a Collection the best option?
I think the collection is the best way to go. Please pardon my ignorance on
this. I could get an array to work, but it is a lot harder to do. It looks
like collections have the advantages of a listbox over an array since there
is no need for tedious redims when you add items. Also the ability to
automatically restrict to unique values is a big plus. I can see where I
could use this in some of my applications. Thanks for the question, I
learned something.

"Stuart" wrote in message
...
Many thanks to you both.

I was trying to use a Collection because I thought I had
read somewhere about it automatically excluding any
duplicates.........sure enough that link to J. W.'s site
confirms this (hence the use of OERN to suppress any
messages).

I imported Tom's code:

However, when I ran the code on my test sheets, it did
not exclude duplicates. Is it worth pursuing (out of
interest) the Collection idea, or perhaps follow the array
route?

Regards.

"Tom Ogilvy" wrote in message
...
I believe it does work (at least it did for me), but you can't see the
result with

msgbox EnquiryList

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value
End If
Next Cell
On Error GoTo 0
End With
Next
sStr = ""
For Each itm In EnquiryList
sStr = sStr & itm & vbNewLine
Next
msgbox sStr
End Sub


See John Walkenbach's site for an example to follow including sorting

http://j-walk.com/ss/excel/tips/tip47.htm

--
Regards,
Tom Ogilvy








Stuart wrote in message
...
I'm looking to take unique values from a defined range
into a form. The values will be alphabetic characters.
Here is what I have so far:

Sub SortContractorsSuppliers()

Dim ws As Worksheet, LastRow As Long
Dim DataRange As Range, Cell As Range
Dim EnquiryList As New Collection

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("H65536") _
.End(xlUp).Row, .Range("I65536").End(xlUp).Row, _
.Range("J65536").End(xlUp).Row)
Set DataRange = Range("H2", "J" & LastRow)
On Error Resume Next
For Each Cell In DataRange
If Not IsEmpty(Cell) Then
EnquiryList.Add Cell.Value
End If
Next Cell
On Error GoTo 0
End With
Next

MsgBox EnquiryList

End Sub

Why is it that when the code loops into the 2nd sheet, any
unique values in that sheet's DataRange are not added to the
Collection, please?

Regards.





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.512 / Virus Database: 309 - Release Date: 19/08/2003




Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Dont have secondary axis option listed in Series Option Venus Charts and Charting in Excel 3 February 23rd 10 07:30 PM
preserve formatting option in pivot table option dialog box Dave F Excel Discussion (Misc queries) 4 May 8th 08 07:25 PM
keep source formatting is not an option in paste option button Tina Excel Discussion (Misc queries) 0 February 20th 06 09:58 PM
Reformat IF(ISERROR(....) : if 1st option returns empty, look at 2nd option. sonar Excel Worksheet Functions 3 September 12th 05 09:52 PM
Is a Collection the best option? Bradley Dawson Excel Programming 1 August 31st 03 08:14 PM


All times are GMT +1. The time now is 03:40 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement