Disable clicking and other events while program is running

[greenguy]

Howdy,

I've written some code to compare data and it takes approximately 13-15 minutes to finish. I have a few problems though.

1. If I left click the screen while the program is running the program stops
2. If any notifications popup (Lotus Notes notifications) the program stops
3. If the unattended my pc will go into login mode and the program stops

I thought some of the lines in my code would prevent the user from clicking as well as (Application.Interactive = False) and I'm not sure about (Application.IgnoreRemoteRequests = False). Anyway my code is below. If anyone has some thoughts other than I really don't know what I'm doing It would be much appreciated. Thanks

[Sub Run_Comparison()

Dim lrowold As Long
Dim lrownew As Long
Dim lrow As Long
Dim lcolold As Long
Dim lcolnew As Long
Dim cellold As Range
Dim cellnew As Range
Dim r As Long
Dim c As Integer
Dim nw
Dim ol


Application.ScreenUpdating = False
Application.Interactive = False
Application.IgnoreRemoteRequests = False
Application.StatusBar = ""

Sheets("Old").Activate
lrowold = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("New").Activate
lrownew = Cells(Rows.Count, 1).End(xlUp).Row
If lrownew >= lrownew Then
lrow = lrownew
Else
row = lrowold
End If

Sheets("Old").Activate
lcolold = Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("New").Activate
lcolnew = Cells(1, Columns.Count).End(xlToLeft).Column

If Cells(1, lcolnew) = "Mismatch" Then
lcolnew = lcolnew - 1
Else
Cells(1, lcolnew + 1) = "Mismatch"
End If

If lcolnew <> lcolold Then
MsgBox "Column counts do not match!", vbExclamation + vbOKOnly, "Column Mismatch"
Exit Sub
Else
lcol = lcolnew - 1
Cells(1, lcolnew + 1) = "Mismatch"
End If

r = 2
c = 1
Sheets("New").Activate
Application.StatusBar = "Comparing lines " & r - 1 & "/" & lrow - 1
Do Until r = lrow + 1
Do Until c = lcol
Cells(r, c).Activate
nw = ActiveCell.Value
Sheets("Old").Activate
Cells(r, c).Activate
ol = ActiveCell.Value
'Color cells and place an x under the mismatch column _
if new data does not match old data
Sheets("New").Activate
If nw <> ol Then
Cells(r, lcolnew + 1) = "x"
Range(Cells(r, c), Cells(r, c)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
End If
c = c + 1
Sheets("New").Activate
Loop
r = r + 1
c = 1
If r > lrow Then Exit Do

Application.StatusBar = "Comparing lines " & r - 1 & "/" & lrow - 1

Loop

'Filter for x to display only items _
that have changed
Range("A1:A" & lrownew).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter

'Scroll to the left and select the first cell first column
ActiveWindow.ScrollColumn = 45
Selection.AutoFilter Field:=60, Criteria1:="x"

For n = 45 To 1 Step -1
ActiveWindow.ScrollColumn = n
Next n

Range("A1").Select
Application.StatusBar = "Comparison Complete"
Application.ScreenUpdating = True
Application.Interactive = True
Application.IgnoreRemoteRequests = True]

 

[ajetrumpet]

to get a response, please clean up the post. code in brackets...

 

[boblarson]

to get a response, please clean up the post. code in brackets...

To go with Adam's comments - here's a Visual on how to do that (where and what to type in the forum around your code):

 

[greenguy]

My apologies guys, I don't post a lot of code on the forums.

Sub Run_Comparison()

Dim lrowold As Long
Dim lrownew As Long
Dim lrow As Long
Dim lcolold As Long
Dim lcolnew As Long
Dim cellold As Range
Dim cellnew As Range
Dim r As Long
Dim c As Integer
Dim nw
Dim ol


Application.ScreenUpdating = False
Application.Interactive = False
Application.IgnoreRemoteRequests = True
Application.StatusBar = ""

Sheets("Old").Activate
lrowold = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("New").Activate
lrownew = Cells(Rows.Count, 1).End(xlUp).Row
If lrownew >= lrownew Then
  lrow = lrownew
  Else
    lrow = lrowold
End If
Sheets("Old").Activate
lcolold = Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("New").Activate
lcolnew = Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, lcolnew) = "Mismatch" Then
  lcolnew = lcolnew - 1
  Else
    Cells(1, lcolnew + 1) = "Mismatch"
End If

If lcolnew <> lcolold Then
  MsgBox "Column counts do not match!", vbExclamation + vbOKOnly, "Column Mismatch"
  Exit Sub
  Else
  lcol = lcolnew - 1
  Cells(1, lcolnew + 1) = "Mismatch"
End If
r = 2
c = 1
Sheets("New").Activate
Application.StatusBar = "Comparing lines " & r - 1 & "/" & lrow - 1
Do Until r = lrow + 1
  Do Until c = lcol
    Cells(r, c).Activate
    nw = ActiveCell.Value
    Sheets("Old").Activate
    Cells(r, c).Activate
    ol = ActiveCell.Value
    'Color cells and place an x under the mismatch column _
    if new data does not match old data
    Sheets("New").Activate
    If nw <> ol Then
      Cells(r, lcolnew + 1) = "x"
        Range(Cells(r, c), Cells(r, c)).Select
        With Selection.Interior
          .ColorIndex = 36
          .Pattern = xlSolid
        End With
    End If
    c = c + 1
    Sheets("New").Activate
    Loop
  r = r + 1
  c = 1
  If r > lrow Then Exit Do
  Application.StatusBar = "Comparing lines " & r - 1 & "/" & lrow - 1
Loop

'Filter for x to display only items _
that have changed
    Range("A1:A" & lrownew).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter

'Scroll to the left and select the first cell first column
    ActiveWindow.ScrollColumn = 45
    Selection.AutoFilter Field:=60, Criteria1:="x"
   For n = 45 To 1 Step -1
    ActiveWindow.ScrollColumn = n
   Next n
   
   Range("A1").Select
   Application.StatusBar = "Comparison Complete"
Application.ScreenUpdating = True
Application.Interactive = True
Application.IgnoreRemoteRequests = False
End Sub