Workbook_SheetBeforeDoubleClick function disabled after VBA Solver execution

holditall

New Member
Joined
Dec 30, 2008
Messages
17
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
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
1,694
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
Code:
Application.EnableEvents = True
just the line before before End Sub.

Bye.
 

holditall

New Member
Joined
Dec 30, 2008
Messages
17
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
 

Watch MrExcel Video

Forum statistics

Threads
1,095,364
Messages
5,444,027
Members
405,261
Latest member
Khauff

This Week's Hot Topics

Top