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

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