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").Activate  'back to first sheet to populate with found value sdept
ActiveCell.Value = sdept
ActiveCell.Offset(1, 0).Select

Loop

Application.ScreenUpdating = True
MsgBox "Macro ran successfully in " & _
FormatDateTime(Now() - dtStartTime, 3), vbInformation
End Sub


EDIT I was able to get around the back and forth of updating sheets but it still takes the same amount of time. So this narrows it down to the loop itself. This is what I replaced in case it helps anyone. I found it extremly helpful that you could call the rFound.address. Once I knew I could call that then I could use the offset to refer to the other values.

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

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

If rFound Is Nothing Then
sdept = ""
End If

If (sdate >= sEff And sdate <= sTerm) Or sTerm = "" Then
sdept = rFound.Offset(0, 2).Value
Else: sdept = ""
End If

' Sheets("Data").Activate
ActiveCell.Value = sdept
ActiveCell.Offset(1, 0).Select

• Why won't a VLookup work here? Always prefer native excel functions to VBA. – RubberDuck Aug 18 '15 at 23:55
• That was my first thought but won't the vlookup only return the first match found? I could have the same value returned more than once but I need the other values from that specific row. Does that make sense? I'm looking at setting the range as a variant, writing in to the variant and then dumping it back. – mrbungle Aug 19 '15 at 0:33
• Okay, yeah. That makes sense. Yes, you're right, VLookup will only return the first match. You'd definitely do better to write the range to an array rather than repeatedly accessing the worksheet. How big is the data you're looking at? 12 min. Seems like a long time. Have you considered connecting via an ADODB connection and querying the data you're looking for? – RubberDuck Aug 19 '15 at 0:44
• 26k rows that will grow. ADODB could be a way to go but of course that'd be a reworking of the process, something to think about though. The two sheets are basically coming from two different databases. Now you got me thinking. :) – mrbungle Aug 19 '15 at 0:51
• The great thing about ADODB is that you can write join statements, which sound like what you're looking for. Of course, you're right. It would likely be a complete rewrite. – RubberDuck Aug 19 '15 at 0:57

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:

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

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

3. 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)

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

• Thanks, I've been working on this and suggestion #3 really made the big difference, just over a minute to run. I tried working within the formula realm but just couldn't get it to work. I did also rework the code based on suggestions 2 and 4, those totally make sense. Thanks for the helpful suggestios. – mrbungle Aug 19 '15 at 17:04