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
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