Workbook_SheetBeforeDoubleClick function disabled after VBA Solver execution

[holditall]

Dear all,

I have stunnning problem. The below sub A) in the WorkBook Holder executes a code in another sheet on DoubleClick. This works just fine and has been extensively tested.
After VBA calls a B) Solver problem this function does not seem to work anymore (no action is taken). The whole project consists out of three interdependent Workbooks, in each Workbook the A) code is stored. And before executung the SOLVER it works just fine. Afterwards the functionality is no longer available in neither of the work books!

Strange enough, all other macros excecutedby command buttons or still do work!

Thanks a lot!

Axel




A)


Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim str As String
str = Target
Application.Run "'2__calulate compunds single edition V31.xls'!CalculateOnDoubbleClickAndFillIn", str
End Sub


B)
Sub FitAllNonZerosMacro()
starttime = Time
Windows("3__peak search V16.xls").Activate
Sheets("Fitting").Activate
ByChangeValues = ""
SolverReset
SolverOptions Scaling:=True

ScreenUpdating = False

' Load ChangeValues for all non Zero, non Formula containing cells
For x = 1 To 10
For y = 1 To 3
If Cells(y + 6, x + 2) > 0 Then
If Cells(y + 6, x + 2).HasFormula = False Then
ByChangeValues = ByChangeValues & Cells(y + 6, x + 2).Address & ","
End If
End If
Next y
Next x
For x = 1 To 3
y = 4
If Cells(y + 6, x + 2) > 0 Then
If Cells(y + 6, x + 2).HasFormula = False Then
ByChangeValues = ByChangeValues & Cells(y + 6, x + 2).Address & ","
End If
End If
Next x
For x = 1 To 2
y = 5
If Cells(y + 6, x + 2) > 0 Then
If Cells(y + 6, x + 2).HasFormula = False Then
ByChangeValues = ByChangeValues & Cells(y + 6, x + 2).Address & ","
End If
End If
Next x
x = 1
y = 6
If Cells(y + 6, x + 2) > 0 Then
If Cells(y + 6, x + 2).HasFormula = False Then
ByChangeValues = ByChangeValues & Cells(y + 6, x + 2).Address & ","
End If
End If

' cut off that crazy last "," grrrr....
lengthofthatidiote = Len(ByChangeValues)
ByChangeValues = Mid(ByChangeValues, 1, lengthofthatidiote - 1)

If Sheets("Fitting").FitSignalStability = True Then
ByChangeValues = ByChangeValues & ",$C$13"
End If
SolverOk SetCell:="$J$14", MaxMinVal:=2, ValueOf:="0", ByChange:=ByChangeValues


On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler




' Enter lowerlimits
For x = 1 To 10
For y = 1 To 3
SolverAdd CellRef:=Cells(y + 6, x + 2).Address, Relation:=3, FormulaText:=Cells(y + 18, x + 2).Address
Next y
Next x
For x = 1 To 3
y = 4
SolverAdd CellRef:=Cells(y + 6, x + 2).Address, Relation:=3, FormulaText:=Cells(y + 18, x + 2).Address
Next x
For x = 1 To 2
y = 5
SolverAdd CellRef:=Cells(y + 6, x + 2).Address, Relation:=3, FormulaText:=Cells(y + 18, x + 2).Address
Next x
x = 1
y = 6
SolverAdd CellRef:=Cells(y + 6, x + 2).Address, Relation:=3, FormulaText:=Cells(y + 18, x + 2).Address
'Enter uperlimits
For x = 1 To 10
For y = 2 To 3
SolverAdd CellRef:=Cells(y + 6, x + 2).Address, Relation:=1, FormulaText:=Cells(y + 26, x + 2).Address
Next y
Next x
For x = 1 To 3
y = 4
SolverAdd CellRef:=Cells(y + 6, x + 2).Address, Relation:=1, FormulaText:=Cells(y + 26, x + 2).Address
Next x
For x = 1 To 2
y = 5
SolverAdd CellRef:=Cells(y + 6, x + 2).Address, Relation:=1, FormulaText:=Cells(y + 26, x + 2).Address
Next x
x = 1
y = 6
SolverAdd CellRef:=Cells(y + 6, x + 2).Address, Relation:=1, FormulaText:=Cells(y + 26, x + 2).Address


SolverAdd CellRef:="$C$13", Relation:=1, FormulaText:="$P$22"
SolverAdd CellRef:="$C$13", Relation:=3, FormulaText:="$P$23"

SolverOptions MaxTime:=16000, Iterations:=25000, Precision:=0.000000001, IntTolerance:=0.00001
Application.EnableEvents = False
Application.DisplayAlerts = False


ScreenUpdating = True
Sheets("Main Fit Chart").Activate
ScreenUpdating = False
Sheets("Fitting").Select
SolverOptions (StepThru = False)
SolverSolve Userfinish:=True
SolverFinish KeepFinal:=1

handleCancel:
If Err = 18 Then
MsgBox "You cancelled after " & Time - starttime
End If

End Sub

 

[Anthony47]

Your Sub FitAllNonZerosMacro() contains the instruction Application.EnableEvents = False that is not paired by an Application.EnableEvents = True before the end of the macro. It means that further "events" are blocked, thus the event double-click is mo longer detected.

Simply add

Application.EnableEvents = True

just the line before before End Sub.

Bye.

 

[holditall]

Thanks! This was indeed the missing code!

Unfortunately my code does in principle performs as it should, but it does not feed in the values of the solver interim results after each step into the excel sheet.
It does so if I ask him to StepThru:=True and not call the Function below

Function ShowTrial(Reason As Integer)
ShowTrial = False
ScreenUpdating = True
End Function

via answer = SolverSolve(True, "ShowTrial")

But in this cas of course I have to press the button each itteration manually.

Any ideas?

Thanks anyhow!

Best new year Axel