PDA

View Full Version : 1004 / Out of memory

Meskit
12-02-2009, 11:25 AM
Hi all. iīm new to this forum. Recently, developing my master thesis, i had to run a simple code in vba, for least squares formulation. I get an error in the end, evean when itīs similar to the above code - Run Time Error 1004 - Application-defined or Object-defined error. Later i received the following error as well: Out of Memory. in line :banghead: ("mmmm = Application.WorksheetFunction.MMult(mmm, fcrit_aux)"

If someone could help me i would appreciate that, i am no expert in vba, but i had look at this end for many hours, and didnīt find anything that solve my problem! Some code is just to comprove what i was doing.

Dim m(1 To 50, 1 To 50), fcrit(1 To 50)
Dim m_aux(), mt_aux(), fcrit_aux()
Dim mt(), mm(), mn(), mmm(), mmmm()
Dim pop, nv, i, j As Double

Sub teste()

pop = 6
nv = 3

ReDim m_aux(1 To pop, 1 To nv)
ReDim fcrit_aux(1 To pop)

For i = 1 To pop
For j = 1 To nv
m(i, j) = Rnd() * 20
m_aux(i, j) = m(i, j)
Cells(i, j) = m(i, j)
Next j
fcrit(i) = Rnd() * 10
fcrit_aux(i) = fcrit(i)
Cells(i, 5) = fcrit(i)
Next i

mt = Application.WorksheetFunction.Transpose(m_aux)

For i = 1 To nv
For j = 1 To pop
Cells(i + 10, j) = mt(i, j)
Next j
Next i

mm = Application.WorksheetFunction.MMult(mt, m_aux)

For i = 1 To nv
For j = 1 To nv
Cells(i + 15, j) = mm(i, j)
Next j
Next i

ReDim minv(1 To nv, 1 To nv)
minv = Application.WorksheetFunction.MInverse(mm)

For i = 1 To nv
For j = 1 To nv
Cells(i + 20, j) = minv(i, j)
Next j
Next i

ReDim mmm(1 To nv, 1 To pop)
mmm = Application.WorksheetFunction.MMult(minv, mt)

For i = 1 To nv
For j = 1 To pop
Cells(i + 25, j) = mmm(i, j)
Next j
Next i

ReDim mmmm(1 To nv)

For i = 1 To nv
Cells(i + 29) = mmmm(i)
Next i

End Sub

xld
12-02-2009, 12:03 PM
Your two arrays, mmm and fcrit_aux, should be transversely dimensioned, nxm and mxn, whereas yours are 3x6 and 1x6.

The code can be done without loops

Sub teste()

pop = 6
nv = 3

ReDim m_aux(1 To pop, 1 To nv)
ReDim fcrit_aux(1 To pop)

For i = 1 To pop
For j = 1 To nv
m(i, j) = Rnd() * 20
m_aux(i, j) = m(i, j)
Next j
fcrit(i) = Rnd() * 10
fcrit_aux(i) = fcrit(i)
Next i
Cells(1, 1).Resize(pop, nv) = m_aux
Cells(1, 5).Resize(pop) = Application.Transpose(fcrit)

mt = Application.Transpose(m_aux)
Cells(11, 1).Resize(nv, pop) = mt

mm = Application.MMult(mt, m_aux)
Cells(16, 1).Resize(nv, nv) = mm

ReDim minv(1 To nv, 1 To nv)
minv = Application.MInverse(mm)
Cells(21, 1).Resize(nv, nv) = minv

ReDim mmm(1 To nv, 1 To pop)
mmm = Application.MMult(minv, mt)
Cells(26, 1).Resize(nv, pop) = mmm

ReDim mmmm(1 To nv)
mmmm = Application.MMult(mmm, fcrit_aux) ': banghead:
Cells(29).Resize(nv) = mmmm

End Sub

Meskit
12-02-2009, 02:50 PM
isnīt fcrit_aux a 6x1 matrix? and mmmm 3x6 matrix?

it would result in (3x6)X(6x1)=(3x1)

with your code i get a type mysmatch error, maybe because of that. How can i change this? With add watch i see that mmmm is a 3x1 array ;fcrit_aux 6x1 and mmmm 3x1.