View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Stuart[_5_] Stuart[_5_] is offline
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