Permutations in a class modules

[troelsi]

Dear experts!

I have to make a very large number of permutations in a class-module, but before the permutation is made the benefits of it is evaluated. In order to evaluate the move, I've made a temporary copy of the module in which the move is made and then evaluated, if the move pays off the original module is overwritten by the copy.

In pseudo code it looks something like this:

[vba]
set ClassOrg as class1
set ClassCopy as class2

for i = lbound(ClassOrg) to ubound(ClassOrg)
with classorg(i)
ClassCopy(i).data1=.data1
ClassCopy(i).data2=.data2
end with
next i

'A function who makes a permutation is called
Move(ClassCopy())

'A function named evaluate() is called, it evaluates the move
EvaluateMove = Evalutate(classcopy())

If EvalutateMove < EvaluateOld then
EvaluateOld=EvaluateMove
for i = lbound(ClassOrg) to ubound(ClassOrg)
with classorg(i)
.data1=ClassCopy(i).data1
.data2=ClassCopy(i).data2
end with
next i
end if

[/vba]

The above method works, however, since the classes contains nearly 200 entryes, it seems rather time-consumeing to cycle the classes every time a permutation has to be made.
Is there a faster way to do this?

Thanks
/troelsi

[mikerickson]

It may depend on how the class is written, but if a ByRef copy is sufficiant
[VBA]Set ClassCopy = ClassOrg[/VBA] should work.

[troelsi]

I'm sorry but I don't know what you mean. I'm no expert on classes.
The solution you provided doesn't seem to work. Perhaps I should mention that my class is an array of arrays.

This is how I make the copy:

[vba]
For i = 1 To 8
If ordrerind(i) > 0 Then
x = linienrlok(i)
ReDim xg(ordrerind(i))
For j = LBound(x) To UBound(x)
Set xg(j) = New xt
With xg(j)
.varenr = x(j).varenr
.recept = x(j).recept
.Tid = x(j).Tid
.linie = x(j).linie
.AkumTid = x(j).AkumTid
.ProdTid = x(j).ProdTid
.mangde = x(j).mangde
.RMangde = x(j).RMangde
End With
LinieGam(i) = xg
next j
end if
next i
[/vba]

Liniegam() is a copy of linienrlok.
xg() is a copy of x()
ordrerind(i) is the number entryes in x(), so ubound(x) equals ordrerind(i).

[mikerickson]

It would help to see the class module. Could you post it or attach a workbook?

[troelsi]

I figured that I might as well post most of the code.
Here is the class modules and two sub-routines that are part of a larger project.
It's a bit of a mess, I apologize for that. It works as it is, but I would like it to be faster.

[vba]
'A Class Module named xt
Private mVarenr As String
Private mRecept As String
Private mTid As Variant
Private mLinie As Integer
Private mAkumTid As Single
Private mProdTid As Single
Private mMangde As Single
Private mRMangde As Single


Public Property Get varenr() As String
varenr = mVarenr
End Property
Public Property Let varenr(ByVal vNewValue As String)
mVarenr = vNewValue
End Property
Public Property Get recept() As String
recept = mRecept
End Property
Public Property Let recept(ByVal vNewValue As String)
mRecept = vNewValue
End Property
Public Property Get Tid() As Variant
Tid = mTid
End Property
Public Property Let Tid(ByVal vNewValue As Variant)
mTid = vNewValue
End Property

Public Property Get linie() As Integer
linie = mLinie
End Property
Public Property Let linie(ByVal vNewValue As Integer)
mLinie = vNewValue
End Property
Public Property Get AkumTid() As Single
AkumTid = mAkumTid
End Property
Public Property Let AkumTid(ByVal vNewValue As Single)
mAkumTid = vNewValue
End Property
Public Property Get ProdTid() As Single
ProdTid = mProdTid
End Property
Public Property Let ProdTid(ByVal vNewValue As Single)
mProdTid = vNewValue
End Property
Public Property Get mangde() As Single
mangde = mMangde
End Property
Public Property Let mangde(ByVal vNewValue As Single)
mMangde = vNewValue
End Property
Public Property Get RMangde() As Single
RMangde = mRMangde
End Property
Public Property Let RMangde(ByVal vNewValue As Single)
mRMangde = vNewValue
End Property

'A Class Module named xbyt
Private mbVarenr As String
Private mbRecept As String
Private mbTid As Variant
Private mbLinie As Integer
Private mbAkumTid As Single
Private mbProdTid As Single
Private mbMangde As Single
Private mbRMangde As Single

Public Property Get varenr() As String
varenr = mbVarenr
End Property
Public Property Let varenr(ByVal vNewValue As String)
mbVarenr = vNewValue
End Property
Public Property Get recept() As String
recept = mbRecept
End Property
Public Property Let recept(ByVal vNewValue As String)
mbRecept = vNewValue
End Property
Public Property Get Tid() As Variant
Tid = mbTid
End Property
Public Property Let Tid(ByVal vNewValue As Variant)
mbTid = vNewValue
End Property

Public Property Get linie() As Integer
linie = mbLinie
End Property
Public Property Let linie(ByVal vNewValue As Integer)
mbLinie = vNewValue
End Property
Public Property Get AkumTid() As Single
AkumTid = mbAkumTid
End Property
Public Property Let AkumTid(ByVal vNewValue As Single)
mbAkumTid = vNewValue
End Property
Public Property Get ProdTid() As Single
ProdTid = mbProdTid
End Property
Public Property Let ProdTid(ByVal vNewValue As Single)
mbProdTid = vNewValue
End Property
Public Property Get mangde() As Single
mangde = mbMangde
End Property
Public Property Let mangde(ByVal vNewValue As Single)
mbMangde = vNewValue
End Property
Public Property Get RMangde() As Single
RMangde = mbRMangde
End Property
Public Property Let RMangde(ByVal vNewValue As Single)
mbRMangde = vNewValue
End Property

Sub tilfaldig(linienrlok() As Variant, ordrerind() As Integer)
'Linienrlok() is transfered from the master module, it's originally a class xt, similar to liniegam() below
Dim start As Double
start = timer
Dim i, j, linie As Integer
Dim tal1 As Single
ReDim BytFra(1)
ReDim BytTil(1)
Dim AntByt As Integer
Dim LinieGam(), xg() As xt
Dim LinieByt(), xb() As xByt
Dim BytTilKand() As Integer
Dim tempint As Integer
Dim foretagbyt As Boolean
ReDim LinieGam(1 To 8)
ReDim LinieByt(1 To 8)
'There is 8 productionlines and here it's decided, at which productionline the permutations should be made
If evalgl < 10000 Then
Randomize
tal1 = Rnd
For i = 1 To 8
If i = 1 Then
If tal1 <= interval(i) Then
linie = i
Exit For
End If
ElseIf tal1 <= interval(i) And tal1 > interval(i - 1) Then
linie = i
Exit For
End If
Next i
Else
linie = 1
End If
'The first candidate that should be involved in a move is determined
Randomize
BytFra(1) = Int((ordrerind(linie) - 1 + 1) * Rnd + 1)
' Two copies of the class xt is being made
For i = 1 To 8
Set LinieGam(i) = New xt
Set LinieByt(i) = New xByt
If ordrerind(i) > 0 Then
x = linienrlok(i)
ReDim xg(ordrerind(i))
ReDim xb(ordrerind(i))
For j = LBound(x) To UBound(x)
Set xg(j) = New xt
With xg(j)
.varenr = x(j).varenr
.recept = x(j).recept
.Tid = x(j).Tid
.linie = x(j).linie
.AkumTid = x(j).AkumTid
.ProdTid = x(j).ProdTid
.mangde = x(j).mangde
.RMangde = x(j).RMangde
End With
LinieGam(i) = xg
Set xb(j) = New xByt
With xb(j)
.varenr = x(j).varenr
.recept = x(j).recept
.Tid = x(j).Tid
.linie = x(j).linie
.AkumTid = x(j).AkumTid
.ProdTid = x(j).ProdTid
.mangde = x(j).mangde
.RMangde = x(j).RMangde
End With
LinieByt(i) = xb
Next j
End If
Next i
'tempint is the number of moves that should be evaluated, and it depends on the number of producitonruns at a given line
tempint = Int((ordrerind(linie)) * 0.05) + 1
ReDim BytTilKand(tempint)
ReDim eval(tempint)
For i = 1 To tempint
ReDim BytTil(1)
If ordrerind(linie) > 0 Then
x = LinieGam(linie)
xb = LinieByt(linie)
For j = LBound(x) To UBound(x)
With xb(j)
.varenr = x(j).varenr
.recept = x(j).recept
.Tid = x(j).Tid
.linie = x(j).linie
.AkumTid = x(j).AkumTid
.ProdTid = x(j).ProdTid
.mangde = x(j).mangde
.RMangde = x(j).RMangde
End With
LinieByt(linie) = xb
Next j
End If

'Linienrlok() is the "class" that is being used
For j = 1 To 8
If ordrerind(j) > 0 Then
linienrlok(j) = LinieByt(j)
End If
Next j

'The rest of the candidates for a move is determined
Randomize
x = linienrlok(linie)
If Int((ordrerind(linie) - 1 + 1) * Rnd + 1) <> BytFra(1) Then
If x(BytFra(1)).varenr <> x(Int((ordrerind(linie) - 1 + 1) * Rnd + 1)).varenr Then
BytTil(1) = Int((ordrerind(linie) - 1 + 1) * Rnd + 1)
BytTilKand(i) = BytTil(1)
AntByt = AntByt + 1
End If
End If

'It's eaxminded if the moves are tabu-listed
For j = 1 To 10
If TabuTilf(linie, j).fra = BytFra(1) And TabuTilf(linie, j).til = BytTil(1) Then ' OR/AND
If i = tempint Then
TimeTilf = TimeTilf + timer - start
Exit Sub
Else
GoTo nyti
End If
End If
Next j

'If there none or only one candidate then try again
If BytTil(1) = 0 Then
If i = tempint Then
TimeTilf = TimeTilf + timer - start
Exit Sub
Else
GoTo nyti
End If
End If

'A sub-routine that actually makes the move is called
TimeTilf = TimeTilf + timer - start
Call bytter(linienrlok, linie)
start = timer
'A functions that evaluates the move is called
TimeTilf = TimeTilf + timer - start
eval(i) = evaluerings(linienrlok())
start = timer
nyti:
Next i
'The best move is chosen
For i = 1 To tempint
If eval(i) < evalgl And eval(i) > 0 Then
evalgl = eval(i)
BytTil(1) = BytTilKand(i)
foretagbyt = True
End If
Next i
'Linienrlok is reset to the original
For j = 1 To 8
If ordrerind(j) > 0 Then
linienrlok(j) = LinieGam(j)
End If
Next j
x = linienrlok(linie)
'If there exist a move that improves that leads to a better sollution that move is being made in linienrlok - the original class
If foretagbyt = True Then
If IndTabuTilf = 10 Then
IndTabuTilf = 1
Else
IndTabuTilf = IndTabuTilf + 1
End If
With TabuTilf(linie, IndTabuTilf)
.fra = BytFra(1)
.til = BytTil(1)
End With
TimeTilf = TimeTilf + timer - start
Call bytter(linienrlok, linie)
start = timer
End If
TimeTilf = TimeTilf + timer - start
End Sub

Sub bytter(linienrlok() As Variant, i As Integer)
Dim xb As Variant
xb = linienrlok(i)
Dim TempVar As Variant
For m = 1 To (UBound(BytFra))
TempVar = xb(BytFra(m)).varenr
xb(BytFra(m)).varenr = xb(BytTil(m)).varenr
xb(BytTil(m)).varenr = TempVar

TempVar = xb(BytFra(m)).recept
xb(BytFra(m)).recept = xb(BytTil(m)).recept
xb(BytTil(m)).recept = TempVar

TempVar = xb(BytFra(m)).Tid
xb(BytFra(m)).Tid = xb(BytTil(m)).Tid
xb(BytTil(m)).Tid = TempVar

TempVar = xb(BytFra(m)).linie
xb(BytFra(m)).linie = xb(BytTil(m)).linie
xb(BytTil(m)).linie = TempVar

TempVar = xb(BytFra(m)).AkumTid
xb(BytFra(m)).AkumTid = xb(BytTil(m)).AkumTid
xb(BytTil(m)).AkumTid = TempVar

TempVar = xb(BytFra(m)).ProdTid
xb(BytFra(m)).ProdTid = xb(BytTil(m)).ProdTid
xb(BytTil(m)).ProdTid = TempVar

TempVar = xb(BytFra(m)).mangde
xb(BytFra(m)).mangde = xb(BytTil(m)).mangde
xb(BytTil(m)).mangde = TempVar

TempVar = xb(BytFra(m)).RMangde
xb(BytFra(m)).RMangde = xb(BytTil(m)).RMangde
xb(BytTil(m)).RMangde = TempVar

Next m
End Sub


[/vba]

Any suggestions on how to make the code faster is greatly appreciated.

/Thanks

[mikerickson]

The class modules look like all of the properties could be expressed as public properties in the Declaration section.

E.G. replace

Private mVarenr As String 

Public Property Get varenr() As String 
    varenr = mVarenr 
    End Property 
Public Property Let varenr(ByVal vNewValue As String) 
    mVarenr = vNewValue 
    End Property

with
[VBA]Public varenr As String[/VBA]

[troelsi]

Thanks for your answer mikerickson.

But what would that do?

Would that allow me to:

[VBA]
set xg =x
[/VBA]

I'm sorry but I don't know much about classes.

Thanks

[Bob Phillips]

It would do nothing that your code doesn't do, it just means less typing. Personally, I think your way is better coding discipline within class modules.

[troelsi]

Thanks XLD.

Do you have any suggestions on how to improve my code?
To be more specific, how to make a temporary copy of the module? As of now I cycle through the entire module to make a copy of it.
Or is there no better way?

Thanks