Refer to other cells besides the one in the Cells.Find

I have the following that loops through a range. When the initial value is found on the second sheet it goes to the cell to be able to compare some date values on the same row. Once the comparison is complete another value from the same row is copied to be placed back onto the first sheet. I believe the Application.Goto which activiates the second sheet and the other Sheets("Data").Activate is really slowing this down. It loops through about 26k rows and takes about 12 minutes. I don't know of another way to refer to the other cells in the second sheet in regards to the found value in both sheets without activating sheets back and forth.

```
Sub oiyuou()

Dim rFound As Range
Dim dtStartTime As Date
dtStartTime = Now()

Application.ScreenUpdating = False
Range("A2").Select

Do Until ActiveCell.Offset(0, 4).Value = ""

Application.StatusBar = ActiveCell.Row
sdate = ActiveCell.Offset(0, 6).Value
sCat = ActiveCell.Offset(0, 1).Value & ActiveCell.Offset(0, 3).Value 'concat of two cells

'find in other worksheet
Set rFound = Sheets("User").Cells.Find(What:=sCat, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If rFound Is Nothing Then
sdept = ""
Else: Application.Goto rFound, True 'i assume this is the way to go so i can compare my sdate with these other values
If (sdate >= ActiveCell.Offset(0, 3).Value And sdate <= ActiveCell.Offset(0, 4).Value) Or ActiveCell.Offset(0, 4).Value = "" Then
sdept = ActiveCell.Offset(0, 2).Value
Else: sdept = ""
End If
End If

Sheets("Data").Acti

Firstly, I think you could use VLOOKUP or INDEX & MATCH functions. You code could always fill column A of the Data sheet with the MATCH function and then read down the rows, using the result of the function, instead of the Find method.

Your code currently only finds the first match found, if you want to check for other matches you will need another loop.

If you want to keep this in "traditional" VBA, rather than use ADODB as suggested by @RubberDuck, then there are a couple things you can try:

-
Try to avoid using ActiveSheet, ActiveCell and Select at all times. I did some testing and this didn't produce much of an imporvement in speed although it makes your code more robust.

-
Not a performance issue, but in your code you currently have these lines of code:

sEff = rFound.Offset(0, 3).Value
sTerm = rFound.Offset(0, 4).Value

immediately after the Find method but before you have tested if rFound Is Nothing so these lines will throw an error when the Find doesn't return a Range object.

-
Do you need to search the whole of the User sheet for a matching entry or can you search a single column? Reducing the number of cells through which the Find method must check will give you a big performance increase. So, for example, you could use:

Set rFound = Sheets("User").Range("A1:A26000").Find(What:=sCat, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlPart, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False, _
                                               SearchFormat:=False)

-
In VBA, the AND and OR operators are not "lazy" and will always test both expressions. You might get some improvement if you split the following line into several If .. Then tests:

If (sDate >= sEff And sDate <= sTerm) Or sTerm = "" Then

StackExchange Code Review Q#101314, answer score: 3