5
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ Why won't a VLookup work here? Always prefer native excel functions to VBA. \$\endgroup\$ – RubberDuck Aug 18 '15 at 23:55
  • \$\begingroup\$ 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. \$\endgroup\$ – mrbungle Aug 19 '15 at 0:33
  • \$\begingroup\$ 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? \$\endgroup\$ – RubberDuck Aug 19 '15 at 0:44
  • \$\begingroup\$ 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. :) \$\endgroup\$ – mrbungle Aug 19 '15 at 0:51
  • \$\begingroup\$ 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. \$\endgroup\$ – RubberDuck Aug 19 '15 at 0:57
3
\$\begingroup\$

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
    
\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – mrbungle Aug 19 '15 at 17:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.