Using VBA: Trying to write new solutions ONLY

[Michael]

Hi,

I have this piece of VBA code. I want to write new solutions only as I
am running the solver 50 times for example. See explanations in the
code with questions (each solution is an array of values not single
value):

Dim rng As Range
Dim cella As Range
Dim cell1 As Range
Dim i As Long
Dim cnt As Long
Dim bDup As Boolean

If Not IsEmpty(Cells(10, 3)) Then
' 1st value of 1st solution array is in cell (10,3)

Set rng = Range(Cells(10, 3), Cells(59, 3).End(xlUp))
' 1st solution array starts in cell(10,3), and the 50th solution array
starts
' at cell(59,3)

For Each cella In rng
i = 0
cnt = 0
bDup = False

For Each cell1 In cella.Resize(10, 10)
'each solution array has 10 values

For Each mac In vehicleModel.Macros
solutionArray(i) = mac.Value
' How do you define solutionArray as an array?

If cell1.Value = solutionArray(i) Then
cnt = cnt + 1
End If
Next mac
i = i + 1
Next
If cnt = 10 Then
bDup = True
Exit For
End If
Next
End If
If Not bDup Then
' write array

Help to make this VBA code work would be greatly appreciated.

Mike

 

[Tom Ogilvy]

Dim rng As Range
Dim cella As Range
Dim cell1 As Range
Dim i As Long, k as Long
Dim cnt As Long
Dim bDup As Boolean
Dim SolutionArray(0 to 9) as Variant

for k = 1 to 50
' run the model

' now gather the results
For Each mac In vehicleModel.Macros
solutionArray(i) = mac.Value
Next


If Not IsEmpty(Cells(10, 3)) Then
' 1st value of 1st solution array is in cell (10,3)

Set rng = Range(Cells(10, 3), Cells(60, 3).End(xlUp))
' 1st solution array starts in cell(10,3), and
' the 50th solution array starts
' at cell(59,3)

For Each cella In rng
i = 0
cnt = 0
bDup = False


For Each cell1 In cella.Resize(10, 10)
If cell1.Value = solutionArray(i) Then
cnt = cnt + 1
End I
i = i + 1
Next
If cnt = 10 Then
bDup = True
Exit For
End If
Next
End If
If Not bDup Then
' write array

Next k ' next model run

also see an example in the original thread.

 

[Michael Sultan]

Tom,

It is giving me no errors but still not working as if it is not there!

I do understand your example well. I tried it separately and did work
fine. However, there is one difference here: you assume that the 1000
solutions are already there!

In my case, at each new run it has to check with the previous unique
ones for comparison (i.e. written ones).

So, if I am running the model 50 times, the comparisons are done 50
times too (may be 49 times since the 1st is always unique).

Each solutionArray(0 To 7) has 8 components, the model runs 50 times,
1st solutionArray is from cell(10,3) to cell(10,10).

With that in mind, is your last piece of code still valid or needs some
change?

Thanks for your patience indeed.

Mike

 

[Tom Ogilvy]

If you are going to run the macro after each run of the model, then the only
change would be to take out the loop that ran the model. There was a typo
on the resize command - it was resize(10,10) and should have been
resize(1,10), now resize(1,8) if you only have 8 values in the solution
array. My example doesn't assume the 1000 arrays are all there. It checks
them one at a time as they are generated. They are just all generated in a
loop in the macro. The same yours would be it you could automate the
running of your model.

Dim rng As Range
Dim cella As Range
Dim cell1 As Range
Dim i As Long, k as Long
Dim cnt As Long
Dim bDup As Boolean
Dim SolutionArray(0 to 7) as Variant

' the model has just been run so
' now gather the results
i = 0
' I have no idea what vehicleModel.Macros is, but assume
' it will fill your array with the necessary values.
For Each mac In vehicleModel.Macros
solutionArray(i) = mac.Value
i = i + 1
Next


If Not IsEmpty(Cells(10, 3)) Then
' 1st value of 1st solution array is in cell (10,3)

Set rng = Range(Cells(10, 3), Cells(60, 3).End(xlUp))
' 1st solution array starts in cell(10,3), and
' the 50th solution array starts
' at cell(59,3)

For Each cella In rng
i = 0
cnt = 0
bDup = False


For Each cell1 In cella.Resize(1, 8)
If cell1.Value = solutionArray(i) Then
cnt = cnt + 1
End I
i = i + 1
Next
If cnt = 8 Then
bDup = True
Exit For
End If
Next
End If
If Not bDup Then
' write array

 

[Tom Ogilvy]

Little light on content Michael.

 

[Michael Sultan]

Tom,

Below is the code piece I am using although it is not working yet! Allow
me please to re-state the followings:

1)A solution has 8 components (from 0 to 7),
2)1st solution starts at C10 (i.e. cells(10,3)), and end
at J10,
3)The model is assumed to run 50 times

What else could be missing!?


Dim rng As Range
Dim cella As Range
Dim cell1 As Range
Dim i As Long
Dim solutionArray(0 To 7) As Variant
Dim cnt As Long
Dim bDup As Boolean

Cline = 1
For JobNr = 1 To 50
vehicleModel.Solve
i = 0
For Each mac In vehicleModel.Macros
solutionArray(i) = mac.Value
i = i + 1
Next

If Not IsEmpty(Cells(10, 3)) Then
Set rng = Range(Cells(10, 3), Cells(60, 3).End(xlUp))
For Each cella In rng
i = 0
cnt = 0
bDup = False

For Each cell1 In cella.Resize(1, 8)
If cell1.Value = solutionArray(i) Then

cnt = cnt + 1
MsgBox cnt
End If

i = i + 1
Next
If cnt = 8 Then
bDup = True
Exit For
End If
Next
End If
If Not bDup Then

' write array
NEXT

Thanks Tom,
Mike

 

[Tom Ogilvy]

I can't say.

Perhaps it is working and your problem is trying to use equality with double
precision floating point numbers.

the best I can recommend is that you put in some debugging code and see what
is in your array and what is in your cells and what the results of the
comparison are.


As I demonstrated, the basic approach works. If there is a problem, it is
within the context of applying it to your specific situation/data.