Creating Collections 'on the fly'
 

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

Creating Collections 'on the fly'
 

Thanks for the reply....something new, again.
However I'm getting the error 'Expected array'
when the ReDim statement executes.

Any ideas, please?

Regards.

"Dave Peterson" wrote in message
...
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



---
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

Creating Collections 'on the fly'
 

My mistake. Had no parentheses in the
Dim EnquiryList() As Collection statement (g).

Now as I read the code I'll get Collections
holding values for individual sheets. Can I also
get that original Collection which held the values
for all sheets (unique and sorted, as before), please?

Regards and thanks.

"Dave Peterson" wrote in message
...
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



---
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

Creating Collections 'on the fly'
 

declare a master collection
dim mstrList as collection
....
set mstrlist = new collection

and add it to both the worksheet's collection and this mstrlist:

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)
mstrlist.add cell.value, cstr(cell.value
End If
Next Cell

then outside your loop, sort that using your older code (without the indices).
Just change EntryList to mstrList.


Stuart wrote:

My mistake. Had no parentheses in the
Dim EnquiryList() As Collection statement (g).

Now as I read the code I'll get Collections
holding values for individual sheets. Can I also
get that original Collection which held the values
for all sheets (unique and sorted, as before), please?

Regards and thanks.

"Dave Peterson" wrote in message
...
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


---
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

Creating Collections 'on the fly'
 

Works fine. Many thanks.

Regards.

"Dave Peterson" wrote in message
...
declare a master collection
dim mstrList as collection
...
set mstrlist = new collection

and add it to both the worksheet's collection and this mstrlist:

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)
mstrlist.add cell.value, cstr(cell.value
End If
Next Cell

then outside your loop, sort that using your older code (without the
indices).
Just change EntryList to mstrList.


Stuart wrote:

My mistake. Had no parentheses in the
Dim EnquiryList() As Collection statement (g).

Now as I read the code I'll get Collections
holding values for individual sheets. Can I also
get that original Collection which held the values
for all sheets (unique and sorted, as before), please?

Regards and thanks.

"Dave Peterson" wrote in message
...
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


---
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



---
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