VBA, OLE - Excel is waiting for another application

[justhumm]

I have a macro that iterates through several rows, sending cell values to another program (MathCAD). The other program processes that input, and then excel gets results back from the other program and inserts them into the worksheet.

This had been working fine for some small test batches (100 +/- rows of data), but I am getting an error while trying to process the full data set (5000 rows +/-). It occassionally processes everything correctly, but most times (8/10) it crashes at a random number of iterations (generally anywhere between 100 and 800 data rows) and gives me a pop-up window saying that ""Microsoft Office Excel is waiting for another application to complete an OLE action."

I'm putting the code below for reference. It's not pretty or perfect, but it was working. (I've omitted the variable declarations from the post)

The main routine calls to another input sub. The input sub looks at the other program and counts the number of required inputs (in the applicable MathCAD worksheet); and the user indicates which excel columns each of those inputs are located in. Then the main routine begins iterating through each excel data row, sending those input values to MathCAD. MathCAD processes the single row; and excel calls for the results from MathCAD...and then repeats this process for the rest of the excel data rows.

I tried inserting pauses at a few different locations in the macro, thinking that MathCAD wasn't keeping up with excel, but that didn't seem to help. I randomly tried several other

Any help would be appreciated...maybe someone knows about some background Microsoft thing that needs to be cleaned up...Thanks.

Sub MathCADRoutine()
'Procedure to load ACTIVE Mathcad file
    
    ChDir ActiveWorkbook.Path
    
    Set MC = CreateObject("Mathcad.Application")
    Set WK = MC.Worksheets
    Set WS = MC.ActiveWorksheet
    
    'Get active Mathcad worksheet file path & name and open.
    SheetPath = Application.GetOpenFilename("Mathcad Files, *.xmcd;*.mcd", , _
        "Select Mathcad File")
    Set WS = WK.Open(SheetPath)
    SheetName = WS.Name
      
    'Show dialog box for user to select appropriate forces by loading UserForm
    Call UserInput
    
    '------------------------------------------------------------
    'Send/Recieve values with Mathcad, looping through all Force cases.
    'i as Iterating through rows.
    'j as Iterating each Force type selected.
    '------------------------------------------------------------
Application.ScreenUpdating = False


    ReDim header_array(1 To 3 * CheckCount + 1)
    
    'Place MathCad Filename above Header Row
    Header_Row = First_Row - 1
    ActiveSheet.Cells(Header_Row - 1, Output_Col).Value = SheetName
    ActiveSheet.Cells(Header_Row - 1, Output_Col + 1).Value = MemberID
    ActiveSheet.Cells(Header_Row - 1, Output_Col + 2).Value = "Load Combo: " & LCombo


    doindex = 1
    For i = First_Row To Last_Row
        For j = 1 To ForceCount
            'Send absolute value of forces
            WS.SetValue (ForceNames(j)), Abs(Application.ActiveSheet.Cells(i, ColIndex(j)).Value)
        Next j


        'Pause excel macro to wait for MathCAD to catch up.
        'Application.Wait (Now + TimeValue("0:00:01"))
        'Sleep (3000)    ' delay "1000" milliseconds = 1 second


        k = 0
        'Insert Output Column Headers in Table
        Do While doindex = 1
            For j = 1 To CheckCount
                concatcheck_msg = "CHECK_MSG" & j
                concatDCR = "DCR" & j
                concatcheck = "CHECK" & j


                header_array(j + k) = concatcheck_msg
                k = k + 1
                header_array(j + k) = concatDCR
                k = k + 1
                header_array(j + k) = concatcheck
            Next j


            ActiveSheet.Range(Cells(Header_Row, Output_Col), _
                              Cells(Header_Row, Output_Col + UBound(header_array) - 1)).Value _
                              = header_array
            doindex = doindex + 1
        Loop
        
        k = -1
        For j = 1 To CheckCount
            concatcheck_msg = "CHECK_MSG" & j
            concatDCR = "DCR" & j
            concatcheck = "CHECK" & j
            
            Cells(i, Output_Col + j + k) = WS.GetValue(concatcheck_msg)
            k = k + 1
            Cells(i, Output_Col + j + k) = Format(WS.GetValue(concatDCR), "#.###")
            k = k + 1
            Cells(i, Output_Col + j + k) = WS.GetValue(concatcheck)
                       
        Next j


    Next i




    'Close active Mathcad worksheet and prompt user to save.
    WS.Close (0)
    
Application.ScreenUpdating = True
End Sub




Sub UserInput()
'---------------------------------------------------------------------------
'Run through selected force types and have user select a cell anywhere in the
'data for each respective force type. Force name and force column index
'arrays are generated for tracking purposes.
'---------------------------------------------------------------------------


input_msgLC = "Select cell containing Load Combo name."
Set LCombo = Application.InputBox(Prompt:=input_msgLC, Type:=8)


MemberID = WS.GetValue("MemberID")


InputLoop:
    'until more flexible solution can be figured out,
    'set i = 1 to maximum possible/expected number of inputs
    For i = 1 To 15
        concatinput = "input_msg" & i
        input_msg = WS.GetValue(concatinput)
    On Error GoTo InputLoopError:
        ReDim Preserve input_array(1 To i)
        input_array(i) = input_msg
    Next i
    
InputLoopError:
    Resume CheckLoop:
    
CheckLoop:
    For i = 1 To 15
        concatcheck = "CHECK_MSG" & i
        check = WS.GetValue(concatcheck)
    On Error GoTo CheckLoopError
        ReDim Preserve check_array(1 To i)
        check_array(i) = concatcheck
    Next i
    
CheckLoopError:
    Resume OtherLoops:


OtherLoops:
    ForceCount = UBound(input_array)
    CheckCount = UBound(check_array)
    
    'Generate ColIndex array that will be sent back to MathCAD
    ReDim ColIndex(1 To ForceCount)
    
Application.ScreenUpdating = True
    For i = 1 To ForceCount
        Set ForceCol = Application.InputBox(Prompt:=input_array(i), Type:=8)
        ColIndex(i) = ForceCol.Column
    Next i
Application.ScreenUpdating = False
    
    'Generate ForceNames array that will be sent back to MathCAD
    ReDim ForceNames(1 To ForceCount)
    For i = 1 To ForceCount
        concatinput = "input" & i
        ForceNames(i) = concatinput
    Next i


    'Determine last row of force data to process.
    Last = Application.ActiveSheet.Rows.CountLarge
    Last_Row = Application.ActiveSheet.Cells(Last, ColIndex(1)).End(xlUp).Row
    ActiveSheet.Cells(Last_Row, ColIndex(1)).Activate


    'Determine first row of force data to process.
    Do Until IsNumeric(ActiveCell.Value) <> True
        First_Row = ActiveCell.Row
        ActiveCell.Offset(-1, 0).Select
    Loop


    'Determine first empty column for output results from Mathcad
    Do Until ActiveCell.Value = Empty
        Output_Col = ActiveCell.Column + 1
        ActiveCell.Offset(0, 1).Select
    Loop
    
End Sub

 

[Andrew Poulsom]

Maybe try DoEvents rather than Wait or Sleep.

 

[justhumm]

Thanks for the suggestions, but no dice...

I tried putting DoEvents ("If i Mod 5 = 0 Then DoEvents" - never used it before, but that seemed correct syntax) at a few different locations in the loop and with a few different "mod levels" (50, 10, 5, 2). I was still getting the same error.

I thought I had a breakthrough when I had a few successful runs, where I rebooted windows to see if I needed to clear out memory or something (a stab in the dark), but eventually started getting the same error/warning.

If anyone has any suggestions, they'd be appreciated.

Thanks.