[lnkForumImage]
TotalShareware - Download Free Software

Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

microsoft.public.excel.programming

any function to replace loop

rumkus@hotmail.com

12/14/2006 10:10:00 PM

Below loop works ok. But sheet ("pickuptime2") gets near over 15000
rows and it gets
slower.Any suggestions would be helpful. Thank you very much in
advance.

Sub getpoint(tour As Range, tourdate As Range, hotel As Range)

With Worksheets("pickuptime2")

Set rng1 = .Range("A2", .Range("A" & Rows.count).End(xlUp))

For Each i In rng1
If tour.Value = i.Value And _
tourdate.Value = i.Offset(, 1).Value And _
hotel.Value = i.Offset(, 2) Then

tour.Offset(, 12).Value = i.Offset(, 3)
Exit Sub
End If
Next i

MsgBox " No Value found "

End With

1 Answer

Jim Cone

12/14/2006 10:55:00 PM

0

Function getpoint(Tour As Range, TourDate As Range, Hotel As Range)
Dim i As Excel.Range
Dim rng1 As Excel.Range
Dim varAllValues As Variant

varAllValues = Tour.Value & TourDate.Value & Hotel.Value

With Worksheets("pickuptime2")
Set rng1 = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each i In rng1
If varAllValues = i.Value & i.Offset(, 1).Value & i.Offset(, 2) Then
Tour.Offset(, 12).Value = i.Offset(, 3)
Exit Function
End If
Next i
MsgBox " No Value found "
End Function
'--
Sub FindThePoint()
Call getpoint(Range("B5"), Range("B6"), Range("B7"))
End Sub
-------------
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primiti...



<rumkus@hotmail.com>
wrote in message
Below loop works ok. But sheet ("pickuptime2") gets near over 15000
rows and it gets
slower.Any suggestions would be helpful. Thank you very much in
advance.

Sub getpoint(tour As Range, tourdate As Range, hotel As Range)

With Worksheets("pickuptime2")
Set rng1 = .Range("A2", .Range("A" & Rows.count).End(xlUp))

For Each i In rng1
If tour.Value = i.Value And _
tourdate.Value = i.Offset(, 1).Value And _
hotel.Value = i.Offset(, 2) Then
tour.Offset(, 12).Value = i.Offset(, 3)
Exit Sub
End If
Next i
MsgBox " No Value found "
End With