Maybe you could use an array of collections--one for each worksheet:

Option Explicit
Sub testme03()
Dim ws As Worksheet
Dim EnquiryList() As Collection
Dim LastRow As Long
Dim DataRange As Range
Dim Cell As Range
Dim i As Long
Dim j As Long
Dim Swap1 As Variant
Dim Swap2 As Variant
Dim wsCtr As Long


ReDim EnquiryList(1 To ActiveWorkbook.Worksheets.Count)
wsCtr = 0
For Each ws In ActiveWorkbook.Worksheets
With ws
wsCtr = wsCtr + 1
Set EnquiryList(wsCtr) = New Collection
.Unprotect
LastRow = Application.Max(.Range("G65536") _
.End(xlUp).Row, .Range("H65536").End(xlUp).Row, _
.Range("I65536").End(xlUp).Row)
Set DataRange = .Range("G2", "I" & LastRow)
On Error Resume Next
For Each Cell In DataRange
'use the following to test for single digit data
If Len(Cell.Value) = 1 Then
EnquiryList(wsCtr).Add Cell.Value, CStr(Cell.Value)
End If
Next Cell
On Error GoTo 0


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

End With
Next ws
End Sub

Stuart wrote:

I'm looping through sheets in the activebook,
to build a Collection of the values found in a
specific range in each sheet. The values in the
Collection must be sorted, and unique.
So:

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
LastRow = Application.Max(.Range("G65536") _
.End(xlUp).Row, .Range("H65536").End(xlUp).Row, _
.Range("I65536").End(xlUp).Row)
Set DataRange = .Range("G2", "I" & LastRow)
On Error Resume Next
For Each Cell In DataRange
'use the following to test for single digit data
If Len(Cell.Value) = 1 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

This is fine, but I'm now finding that later in the routine, it
would be very useful to have a sorted Coleection for the
values found in each sheet. To do that during the above
loop would seem the most efficient way.

How do I create the Collections on the fly, please?

Regards.

---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.515 / Virus Database: 313 - Release Date: 01/09/2003

--

Dave Peterson