I have a spreadsheet full of data in this format for a theatre i work
at. Because there are multiple entries for one person I load all the
names into a collection and then use this function (below) to load them
into a listbox. While this method does work it quickly becomes very
slow as we have hundreds of costumers. I was hoping someone could help
me speed it up. Thanks

last name, first name --- seat number ---- adult or student ticket ----
paid or not paid

ReDim data(1 To nodupes.Count, 1 To 4)
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
'For r = 1 To 28
If ActiveSheet.Cells(c, 1).Value = Item And
ActiveSheet.Cells(c, 3) = "Adult" Then
d = d + 1
ElseIf ActiveSheet.Cells(c, 1).Value = Item And
ActiveSheet.Cells(c, 3) = "Student" Then
s = s + 1
End If
data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
'data(f, 4) = ActiveSheet.Cells(c, 5).Value
Next
For c = 1 To 669
If ActiveSheet.Cells(c, 1).Value = Item Then
data(f, 4) = ActiveSheet.Cells(c, 5).Value
End If
Next
d = 0
s = 0
Next Item
ListBox1.List = data

- David

David,
This should be considerably faster.
Note the "Exit For".
I may have overlooked something but
I can't test it, you will have to try it out...
'------------
ReDim data(1 To nodupes.Count, 1 To 4)
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
If ActiveSheet.Cells(c, 1).Value = Item Then
If ActiveSheet.Cells(c, 3) = "Adult" Then
d = d + 1
ElseIf ActiveSheet.Cells(c, 3) = "Student" Then
s = s + 1
End If
data(f, 4) = ActiveSheet.Cells(c, 5).Value
Exit For
End If
Next 'C

data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
d = 0
s = 0
Next 'Item
ListBox1.List = data
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"David"
wrote in message
I have a spreadsheet full of data in this format for a theatre i work
at. Because there are multiple entries for one person I load all the
names into a collection and then use this function (below) to load them
into a listbox. While this method does work it quickly becomes very
slow as we have hundreds of costumers. I was hoping someone could help
me speed it up. Thanks

last name, first name --- seat number ---- adult or student ticket ----
paid or not paid

ReDim data(1 To nodupes.Count, 1 To 4)
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
'For r = 1 To 28
If ActiveSheet.Cells(c, 1).Value = Item And
ActiveSheet.Cells(c, 3) = "Adult" Then
d = d + 1
ElseIf ActiveSheet.Cells(c, 1).Value = Item And
ActiveSheet.Cells(c, 3) = "Student" Then
s = s + 1
End If
data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
'data(f, 4) = ActiveSheet.Cells(c, 5).Value
Next
For c = 1 To 669
If ActiveSheet.Cells(c, 1).Value = Item Then
data(f, 4) = ActiveSheet.Cells(c, 5).Value
End If
Next
d = 0
s = 0
Next Item
ListBox1.List = data

- David

That is considerably faster (thanks for the exit for tip), unfortuantly
the adult and student counter no longer works right, it will only give
a 1 or 0. Any ideas why? Thanks.

- David
Jim Cone wrote:
David,
This should be considerably faster.
Note the "Exit For".
I may have overlooked something but
I can't test it, you will have to try it out...
'------------
ReDim data(1 To nodupes.Count, 1 To 4)
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
If ActiveSheet.Cells(c, 1).Value = Item Then
If ActiveSheet.Cells(c, 3) = "Adult" Then
d = d + 1
ElseIf ActiveSheet.Cells(c, 3) = "Student" Then
s = s + 1
End If
data(f, 4) = ActiveSheet.Cells(c, 5).Value
Exit For
End If
Next 'C

data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
d = 0
s = 0
Next 'Item
ListBox1.List = data
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"David"
wrote in message
I have a spreadsheet full of data in this format for a theatre i work
at. Because there are multiple entries for one person I load all the
names into a collection and then use this function (below) to load them
into a listbox. While this method does work it quickly becomes very
slow as we have hundreds of costumers. I was hoping someone could help
me speed it up. Thanks

last name, first name --- seat number ---- adult or student ticket ----
paid or not paid

ReDim data(1 To nodupes.Count, 1 To 4)
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
'For r = 1 To 28
If ActiveSheet.Cells(c, 1).Value = Item And
ActiveSheet.Cells(c, 3) = "Adult" Then
d = d + 1
ElseIf ActiveSheet.Cells(c, 1).Value = Item And
ActiveSheet.Cells(c, 3) = "Student" Then
s = s + 1
End If
data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
'data(f, 4) = ActiveSheet.Cells(c, 5).Value
Next
For c = 1 To 669
If ActiveSheet.Cells(c, 1).Value = Item Then
data(f, 4) = ActiveSheet.Cells(c, 5).Value
End If
Next
d = 0
s = 0
Next Item
ListBox1.List = data

- David

Well I figured out that it was the exit for causing the problem so it's
still slightly faster than it was. Right now I'm hoping for maybe a
progress bar (as I tried to implement one and I couldn't get it to work
right) or a faster function if possible. Thanks for your help.

- David
David wrote:
That is considerably faster (thanks for the exit for tip), unfortuantly
the adult and student counter no longer works right, it will only give
a 1 or 0. Any ideas why? Thanks.

- David
Jim Cone wrote:
David,
This should be considerably faster.
Note the "Exit For".
I may have overlooked something but
I can't test it, you will have to try it out...
'------------
ReDim data(1 To nodupes.Count, 1 To 4)
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
If ActiveSheet.Cells(c, 1).Value = Item Then
If ActiveSheet.Cells(c, 3) = "Adult" Then
d = d + 1
ElseIf ActiveSheet.Cells(c, 3) = "Student" Then
s = s + 1
End If
data(f, 4) = ActiveSheet.Cells(c, 5).Value
Exit For
End If
Next 'C

data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
d = 0
s = 0
Next 'Item
ListBox1.List = data
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"David"
wrote in message
I have a spreadsheet full of data in this format for a theatre i work
at. Because there are multiple entries for one person I load all the
names into a collection and then use this function (below) to load them
into a listbox. While this method does work it quickly becomes very
slow as we have hundreds of costumers. I was hoping someone could help
me speed it up. Thanks

last name, first name --- seat number ---- adult or student ticket ----
paid or not paid

ReDim data(1 To nodupes.Count, 1 To 4)
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
'For r = 1 To 28
If ActiveSheet.Cells(c, 1).Value = Item And
ActiveSheet.Cells(c, 3) = "Adult" Then
d = d + 1
ElseIf ActiveSheet.Cells(c, 1).Value = Item And
ActiveSheet.Cells(c, 3) = "Student" Then
s = s + 1
End If
data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
'data(f, 4) = ActiveSheet.Cells(c, 5).Value
Next
For c = 1 To 669
If ActiveSheet.Cells(c, 1).Value = Item Then
data(f, 4) = ActiveSheet.Cells(c, 5).Value
End If
Next
d = 0
s = 0
Next Item
ListBox1.List = data

- David

Do you have ScreenUpdating and Calculation turned off while
running your code?
--
Jim Cone
San Francisco, USA
http://www.officeletter.com/blink/specialsort.html


"David"
wrote in message
Well I figured out that it was the exit for causing the problem so it's
still slightly faster than it was. Right now I'm hoping for maybe a
progress bar (as I tried to implement one and I couldn't get it to work
right) or a faster function if possible. Thanks for your help.


- David
David wrote:
That is considerably faster (thanks for the exit for tip), unfortuantly
the adult and student counter no longer works right, it will only give
a 1 or 0. Any ideas why? Thanks.

Try it this way

Dim v as Variant
ReDim data(1 To nodupes.Count, 1 To 4)
v = ActiveSheet.Cells(1,1).Resize(669,5).Value
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
If v(c, 1) = Item Then
If v(c,3) = "Adult" Then
d = d + 1
ElseIf v(c, 3) = "Student" Then
s = s + 1
End If
data(f, 4) = v(c, 5)
End If
Next 'C

data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
d = 0
s = 0
Next 'Item
ListBox1.List = data

I removed the Exit For since it sounds like you have duplicate rows in the
sheet that match the value of item. If that isn't the case, put it back in.

--
Regards,
Tom Ogilvy

I do have duplicate rows and that function worked great. Thanks for the
help.

- David
Tom Ogilvy wrote:
Try it this way

Dim v as Variant
ReDim data(1 To nodupes.Count, 1 To 4)
v = ActiveSheet.Cells(1,1).Resize(669,5).Value
On Error Resume Next
For Each Item In nodupes
f = f + 1
For c = 1 To 669
If v(c, 1) = Item Then
If v(c,3) = "Adult" Then
d = d + 1
ElseIf v(c, 3) = "Student" Then
s = s + 1
End If
data(f, 4) = v(c, 5)
End If
Next 'C

data(f, 1) = Item
data(f, 2) = d
data(f, 3) = s
d = 0
s = 0
Next 'Item
ListBox1.List = data

I removed the Exit For since it sounds like you have duplicate rows in the
sheet that match the value of item. If that isn't the case, put it back in.

--
Regards,
Tom Ogilvy