Bizarre: Code runs slow until window clicked!!???

[VBAjedi]

I've got a module (pasted below) that loops through thousands of rows looking for a key match in either of two ranges on another sheet (same workbook).

The problem is that when I run it (currently triggered from a custom toolbar button), it runs at less than one row per second UNTIL I click somewhere in the Excel window OR somewhere in the VBA Editor window, at which time it speeds up to almost 100 rows per second!!! There's nothing in the click event of either sheet.

It's like something has the focus and is slowing everything down until it loses the focus. . . What the heck?!?!

Here's the code (lengthy and not wrapped well for this forum):

Sub LatestBalances()
Dim LastUSRow As Integer, LastCanRow As Integer, LastSSRow As Integer
Dim USDataRange As Range, CanDataRange As Range, D As Range
Dim Match As Range, OldCurDocAmt As Range
Dim OrigSign As Integer
Dim Company As String, NewDocAmt
Dim FirstMatch As Range
Dim x, y, z

AssignSheets ' Call routine to assign sheets to constants (ShLB, ShSS, etc)
Application.EnableEvents = False
Application.ScreenUpdating = False


ShLB.Range("LBUSLatestBal").QueryTable.Refresh BackgroundQuery:=False
ShLB.Range("LBCanLatestBal").QueryTable.Refresh BackgroundQuery:=False
x = ShLB.Name
LastUSRow = ShLB.Columns("B:B").Cells.Find(What:="*", After:=Range("B65000"), _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
LastCanRow = ShLB.Columns("G:G").Cells.Find(What:="*", After:=Range("G65000"), _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
LastSSRow = ShSS.Cells.Find(What:="*", After:=Range("A65000"), _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row

' ShSS.Range("SSUpdatedAmts").Clear

Set USDataRange = ShLB.Range("B3:B" & LastUSRow)
Set CanDataRange = ShLB.Range("G3:G" & LastCanRow)

ShLB.Activate
Range("LBUSLatestBal").Select

For Each D In ShSS.Range("SSDocNums")
   If D.row > LastSSRow Then Exit For
   Application.StatusBar = "Looking up row #" & D.row
   Company = D.Offset(0, -5).Value ' Company Identifier
   NewDocAmt = ""
   Set OldCurDocAmt = Intersect(ShSS.Rows(D.row & ":" & D.row), ShSS.Range("SSCurDocAmts"))
   If OldCurDocAmt.Value <> 0 Then
      OrigSign = OldCurDocAmt.Value / Abs(OldCurDocAmt.Value)
      With Union(USDataRange, CanDataRange)
         Set Match = .Find(D.Value, LookIn:=xlFormulas, _
           LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
           MatchCase:=False)
         If Not Match Is Nothing Then
            Set FirstMatch = Match ' Mark starting point
            Do
               If Match.Offset(0, -1).Value = Company Then ' Companies match
                  NewDocAmt = Match.Offset(0, 1).Value * OrigSign
               Else
                  Set Match = .FindNext(D)
               End If
            Loop Until Match Is Nothing Or Match = FirstMatch Or NewDocAmt <> &quot;&quot;
         End If
      End With
      If NewDocAmt = &quot;&quot; Then NewDocAmt = &quot;Doc now closed&quot;
   End If
   ShSS.Range(&quot;AD&quot; & D.row).Value = NewDocAmt
Next D

Application.StatusBar = False
Application.EnableEvents = True
Application.ScreenUpdating = True

ShSS.Range(&quot;SSUpdateDate&quot;).Value = &quot;Refreshed &quot; & Date
'Stop
End Sub

Anybody got an idea/hunch about what could be going on?


VBAjedi

 

[VBAjedi]

Ok - still don't know WHY this problem exists, but I found a workaround. If I put an Application.SendKeys("~&quot statement into my code, it runs fast like I'd clicked the window, then actually sends the key (a return char) to whatever the active cell is after the code runs.

Weird!

VBAjedi