Using VBA, how to write unique solutions only?

  • Thread starter Thread starter Michael
  • Start date Start date
M

Michael

Hi everyone,

I run an optimizer n times, say 10, and tell the model to write
feasible solutions into an excel table as follows:

RUN Cost Weight Volume
1 2.3 51.27 20.3
2 3.1 49.2 22.2
3 4.3 37.2 16.7
4 2.3 51.27 20.3
5
6
and so on.

I use a piece of VBA code like this:

Set ARngSolution = Workbooks(filename). _
Worksheets("ParetoFrontier").Range("SolOBJSens")
ARngSolution.Clear
Cline = 1
For JobNr = 1 To 10
result = vehicleModel.ReadModel("MCS2vehicle.mpl")

If result > 0 Then
MsgBox vehicleModel.ErrorMessage
Else
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

Note that solutions # 1 and 4 are identical! I want to write only new
solutions.
What should I add to the above piece to force it to do so?

Thanks alot,
Mike
 
1. You could use 'Data/Filter/Advanced Filter' to Filter unique rows.

2. You could make a text lookup index in another column with formul
like :- =CONCATENATE(FIXED(A1,2),FIXED(B1,2),FIXED(C1,2)) and us
Find in code to check a string of the new entry does not exist befor
adding the record.

3. You could check the previous rows with a loop. eg. :-
'--------------------------------------
Dim Duplicate As Boolean
Dulpicate = False
For rw = 1 To lastline
If Cells(rw, 1).Value = MyColA _
And Cells(rw, 2).Value = MyColB _
And Cells(rw, 3).Value = MyColC Then
Duplicate = True
Next
If Duplicate = False Then
'Code to add line
End If
'----------------------------------------
 
Brian,

I like the 3rd methodology. However I have a question please:

Q: The comparison should start when a 2nd solution is generated. So I
modified your as follows:

For JobNr 1 To 10
..
..
..
Dim Duplicate As Boolean
Dulpicate = False
If JobNr <> 1 Then
For rw = 10 To JobNr + 10 (My table start at row 10, column 3)
If Cells(rw, 3).Value = MyColA And Cells(rw, 4).Value = MyColB _
And Cells(rw, 5).Value = MyColC Then
Duplicate = True
GoTo NextJobNr
End If
Next
End If
..
..
NextJobNr:
Next

It is not working! Only the 1st solution is written! What could be
missing?

Thanks Brian,
Mike
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top