Is there a way to impose a time limit for the code

Question

I was wondering if anyone had any experience imposing time limits on sections of code. I have programmed a search engine into an excel spreadsheet in VBA and there is a section of the code that removes duplicate results. Now this part can sometimes stretch on for quite a long time if given the most vague search criteria. So I would like to impose a time limit for this operation. I have looked everywhere for a solution and tried using OnTime, but it doesnt seem to work in the way I need. Ideally, I'd like an imposed time limit and then when that is reached a GoTo statement, to move it further on in the code. From what I have read the OnTime will not interrupt an operation, but will wait for it to finish instead, this is not what I want.

Thanks for your help guys. Amy

I've added my code:

Sub RemoveDuplicates()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Code called upon through the other macros which will remove duplicates from all the   types of search.
Application.StatusBar = "Removing Duplicates...."

Dim k As Integer
Dim SuperArray As String
Dim CheckingArray As String
Dim Duplicate As Boolean
Dim i As Integer
Dim j As Integer
Dim m As Integer
Dim Endrow As Integer
Dim Endcolumn As Integer
Dim w As Integer
Dim x As Integer
Dim n As Integer

w = 1
x = 9

Endcolumn = Module6.Endcolumn(x)
Endrow = Module6.Endrow(w)

If Worksheets("Search Engine").Cells(9, Endrow) = "Percentage Similarity" Then
    Endrow = Endrow - 1
End If

    For i = 9 To Endcolumn

        j = 1
        k = i + 1

        Do While j <> Endrow + 1
            SuperArray = Cells(i, j) & Superstring
            Superstring = SuperArray
            j = j + 1
        Loop

        For k = k To Endcolumn
            m = 1
            Do While m <> Endrow
                CheckingArray = Cells(k, m) & Uberstring
                Uberstring = CheckingArray
                m = m + 1
            Loop
            If Uberstring = Superstring Then
            n = 1
                Do While n <> Endrow + 1
                If Worksheets("Search Engine").Cells(k, n).Interior.ColorIndex = 37 Then
                    Worksheets("Search Engine").Cells(i, n).Interior.ColorIndex = 37
                End If
                n = n + 1
                Loop
                Rows(k).Clear
            End If
            Uberstring = -1
        Next k
        Superstring = -1
    Next i


Do While i > 9
    If Cells(i, 1) = Empty Then
        Rows(i).Delete
    End If
    i = i - 1
Loop

End Sub

Answer 1

I assume your code must have some kind of loop, e.g. For Each, While ... Wend, Do ... Loop Until, etc.

In theses cases, extend the condition by a comparison to the Timer. This returns you a Double between 0 and 86400, indicating how many seconds have passed since midnight. Thus, you also need to account for the day break. Here is some example code showing you implementations for three different loop constructs:

Sub ExampleLoops()
    Dim dblStart As Double
    Dim tmp As Long

    Const cDblMaxTimeInSeconds As Double = 2.5

    dblStart = Timer

    'Example with For loop
    For tmp = 1 To 1000
        tmp = 1     'to fake a very long loop, replace with your code
        DoEvents    'your code here
        If TimerDiff(dblStart, Timer) > cDblMaxTimeInSeconds Then GoTo Finalize 'Alternative: Exit For
    Next

    'Alternative example for Do loop
    Do
        DoEvents 'your code here
    Loop Until TimerDiff(dblStart, Timer) > cDblMaxTimeInSeconds And False 'your condition here

    'Alternative example for While loop
    While TimerDiff(dblStart, Timer) <= cDblMaxTimeInSeconds And True 'your condtion here
        DoEvents 'your code here
    Wend

Finalize:
    'FinalizeCode here
    Exit Sub
End Sub

Function TimerDiff(dblTimerStart As Double, dblTimerEnd As Double)
    Dim dblTemp As Double
    dblTemp = dblTimerEnd - dblTimerStart
    If dblTemp < -43200 Then 'half a day
        dblTemp = dblTemp + 86400
    End If
    TimerDiff = dblTemp
End Function