Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Creating Collections 'on the fly'
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,824
Default 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

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 413
Default 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


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 413
Default 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


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,824
Default 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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 413
Default 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


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
creating Yes,No Amin Excel Discussion (Misc queries) 3 November 8th 08 10:02 PM
how do i create chart like branch-sector sales & collections Gnana Prasad Excel Discussion (Misc queries) 1 January 11th 08 08:00 AM
creating a pdf Andrew R Excel Discussion (Misc queries) 4 September 19th 06 08:21 PM
minimize the file size in a ppt with collections of many pivot tables chermaine Excel Discussion (Misc queries) 1 December 30th 05 11:04 AM
new sheet created 'on the fly' from template in same workbook - H. MrT Excel Worksheet Functions 3 April 10th 05 08:30 PM


All times are GMT +1. The time now is 10:42 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