VBA question: How can I do that?

[Michael]

Hi everyone,

Say I am running an optimizer from Excel number of times, each time it
assumes a different starting point.

In a VBA code, I tell the model to write the solution into a table if
a feasible solution is found. However, sometimes a solution gets
reaptead! For eaxmple, say I am running the model 20 times and 12 runs
deliver feasible solutions, I find that some of the 12 feasible
solutions are just identical!

So, what should I do to tell the model through VBA not to write down a
feasible solution if it is already there?

Thanks alot,
Mike

 

[Paulw2k]

Hi,

if WorksheetFunction.Countif(Range, SolutionValue)>0 then exit sub (or
whatever)


Paul

 

[jeff]

Hi, Michael,

Your VBA code should be modular enough that when
a solution is found, you go out to a subroutine
to run through the values already found and
compare to your current value - set a flag
one way or the other and when you return to main
code line, simply bypass the "write" if already
there.

This seems too simple, what am I missing?

jeff

 

[Michael]

Hi again everyone,

Let me please put it differently. I am running an optimizer 5 times
from excel using a loop (every run has a different starting point).
Output is written into a tabel like this:

Run Objective value
1 3.5
2 2.7
3 3.7
4 3.5
5

Solution # 5 is blank because it has no feasible solution. However
solutions 1 and 4 are identical! I want the output to be like this:

Run Objective value
1 3.5
2 2.7
3 3.7
4
5

Now solutions 4 and 5 are blanks; no repetition. How could that be
done using VBA?

Mike

 

[Dave Peterson]

Paulw2k's suggestion makes pretty good sense to me:

Say you stick your value in the next open row in column B.

Dim myObjRng as range
dim myVal as double

'do your calculations
myval = 3.7

with worksheets("sheet1")
set myObjRng = .range("b1",.cells(.rows.count,"B").end(xlup))
if application.countif(myobjrng,myval) > 0 then
'already there
else
.cells(.rows.count,"B").end(xlup).offset(1,0).value = myval
end if
end with

 

[Michael]

Thanks Dave. However, I looked in a VBA book I have to see what "xlup"
or "countif" but couldn't find much about it.

Could you please explain what this "with" loop mean?

Thanks in advance,
Mike

 

[Michael]

Dave,

Here is the piece of VBA code I have:

ARngSolution.Clear
BRngSolution.Clear
Cline = 1
For JobNr = 1 To 5
result = vehicleModel.ReadModel("MCS.mpl")

If result > 0 Then
MsgBox vehicleModel.ErrorMessage
Else
Workbooks(filename). _
Worksheets("ParetoFrontier").Range("B7").Value = JobNr

vehicleModel.Solve

Set varVect = vehicleModel.VariableVectors("Assign")

Aline = 1

For Each mac In vehicleModel.Macros
If vehicleModel.Solution.ResultCode = 101 Then
Flag = 1
ARngSolution(Cline, Aline).Value = mac.Value
With ARngSolution(Cline, Aline)
.HorizontalAlignment = xlCenter
.NumberFormat = "#.##0"
End With
Else
Flag = 0
GoTo NextJobNr
End If
Aline = Aline + 1
Next mac

End If

NextJobNr:

Next

This piece of code writes down only the feasible solutions into a
table defined by ARngSolution.

Now, some of these feasible solutions are repeated as explained below.
I want to write down only new solutions. How can I do this?

Thanks again,
Mike

 

[Dave Peterson]

Look in Excel's help for =countif(). It's a worksheet function.

And look in VBA's help for End (as in .cells(...).end(xlup))

It's like hitting the end key and the the up arrow when you're in the worksheet.

The with/end with structure is shown in VBA's help, too.

But if I use that, it means that I save my fingers!

This portion:
with worksheets("sheet1")
set myObjRng = .range("b1",.cells(.rows.count,"B").end(xlup))

could be rewritten as:

set myobjrng = worksheets("sheet1").range("b1", _
worksheets("sheet1").cells(worksheets("sheet1").rows.count, "B") _
.end(xlup))

<<if I translated it correctly! It even hurts my fingers in the post!>>

 

[Dave Peterson]

I don't think that this has a chance of working right out of the box, but it
might give you an idea where things should be checked and where they should go.


Sub testme()
arngsolution.Clear
BRngSolution.Clear
Cline = 1
For jobnr = 1 To 5
result = vehicleModel.ReadModel("MCS.mpl")

If result > 0 Then
MsgBox vehicleModel.ErrorMessage
Else
Workbooks(Filename). _
Worksheets("ParetoFrontier").Range("B7").Value = jobnr

vehicleModel.Solve

Set varVect = vehicleModel.VariableVectors("Assign")

Aline = 1

For Each Mac In vehicleModel.Macros
If vehicleModel.Solution.ResultCode = 101 Then
Flag = 1
If Application.CountIf(arngsolution, Mac.Value) > 0 Then
'do nothing
Else
arngsolution(Cline, Aline).Value = Mac.Value
With arngsolution(Cline, Aline)
.HorizontalAlignment = xlCenter
.NumberFormat = "#.##0"
End With
End If
Else
Flag = 0
GoTo NextJobNr
End If
Aline = Aline + 1
Next Mac

End If

NextJobNr:

Next jobnr

End Sub

The most I'll say is that it compiled without an error.