Excel hangs when switching focus

[Axel Dahmen]

Hi,

I noticed that Excel 2007 (or VBA) hangs on a long-during VBA script when I switch focus between the VBA editor window and the Excel window.


I've written a small Sub to delete rows containing strings having a substring matching the row's above. The worksheet contains about 135,000 rows.

Just want to mention BTW that Excel takes about 1 sec. to delete 10 rows, which is incredibly slow!


While my script executed, just out of curiosity I wanted to switch to the Excel window to see how far it got. From that moment on both, Excel and VBA window, hung. I can't even pause anymore. I can't tell if my script still is running or if it hangs as well.

To me this seems to be a bug. So I'd like to know if anyone can reproduce this behaviour so I can open an issue with MS.

TIA,
Axel Dahmen

 

[Joel]

It is alway quicker to delete multiple cells at one time. I found by adding
a 1 to an auxilary column to indicate what rows you want to delete. Then
sorting on the column and deleting all the ones at one time reduces the time
it takes to delete rows. It take the same time to delete 100 rows at it
would to delete one row. If you don't want to sort, the use an autofilter on
the ones columns and delete the visible cells.

 

[Axel Dahmen]

Thanks Joel, I see...

I just checked and saw that it doesn't actually take 1 sec. to *delete* 10 rows, but just to *iterate* through them. Nothing has been deleted so far because I used a wrong variable in my code.

The hanging also seems only to occur when *nothing* is actually changed. After I've corrected my script to actually delete double rows I can now switch between both windows.

Still the hanging shouldn't occur if the Worksheet isn't updated though.

Can you reproduce the hanging?

TIA,
Axel Dahmen


Here's the code I've been using:

----------
Option Explicit

Sub DelDoubles()
Dim y&
Dim s1$, s2$, p1$, p2$, f1$, f2$
Dim pos1%, pos2%
Dim ws As Worksheet

Set ws = ActiveSheet
For y = ws.UsedRange.Rows.Count - 1 To 1 Step -1

' find last backslash
s1 = ws.UsedRange.Cells(y, 1)
s2 = ws.UsedRange.Cells(y + 1, 1)

' do both paths match?
p1 = Left$(s1, InStrRev(s1, "\") - 1)
p2 = Left$(s2, InStrRev(s2, "\") - 1)
f1 = Mid$(s1, Len(p1) + 1)
f2 = Mid$(s2, Len(p2) + 1)
pos1 = InStrRev(f1, ".")
pos2 = InStrRev(f2, ".")

If p1 = p2 And pos1 > 0 And pos2 > 0 Then
' do both filepaths match and are file names equally long? Then delete second row.
If Mid$(f1, pos1) = Mid$(f2, pos2) And pos1 = pos2 Then ws.UsedRange.Rows(y + 1).Delete
End If
Next
End Sub



-----------------