PDA

View Full Version : Initialize cell with mmult formula



badri.toppur
11-04-2009, 01:14 AM
Hello,
I was referred to this group by Nick from a Linked-in group dedicated to VBA and Excel. I am writing a macro that calls Solver after reading some input from a refedit control on a userform.

For those of you unfamiliar with this package, Solver is a add-in from Frontline systems for doing LP and other types of optimizations. It requires
that a formula for the objective function be specified in a target cell. This is not difficult at the spreadsheet level. The problem is that when I use VBA to write the formula for the objective function into the target cell, it is calculated and only the value pasted in that cell, not the formula. Any help about how the formula can be entered (using VBA) along with the value into the cell, will be appreciated.

Thanks,
Badri

Bob Phillips
11-04-2009, 01:50 AM
Show us the code that you have written that does that work, and we will correct it for you.

In principle, it would just be



Range("A1").Formula = "=MMULT(C10:C13,D10:F10)"

badri.toppur
11-04-2009, 10:41 PM
Thanks for agreeing to take a look at it. I have marked the offending piece of code with a smiley.

Worksheet1 module code:


Private Sub CommandButton1_Click()
Dim i, j As Integer
Dim rng As Range

Dim ws As Worksheet
Dim r1 As Integer, c1 As Integer
Dim r2 As Integer, c2 As Integer

UserForm1.Show
ReDim A(1 To NumberOfCampaigns, 1 To NumberOfQualities) As Variant
ReDim ATRANSPOSE(1 To NumberOfQualities, 1 To NumberOfCampaigns) As Variant
ReDim ATRANSPOSEA(1 To NumberOfQualities, 1 To NumberOfQualities) As Variant

ReDim ATRANSPOSEB(1 To NumberOfQualities, 1 To 1) As Variant
ReDim XATRANSPOSEB(1 To 1) As Variant

ReDim B(1 To NumberOfCampaigns, 1 To 1) As Variant
ReDim BTRANSPOSE(1 To 1, 1 To NumberOfCampaigns) As Variant

ReDim X(1 To 1, 1 To NumberOfQualities) As Variant

If Arng Is Nothing Then Exit Sub

Set ws = ActiveSheet
ws.Activate

'Get used range
Set rng = ws.UsedRange
r1 = rng.Row
r2 = rng.Rows.Count + r1 - 1
c1 = rng.Column
c2 = rng.Columns.Count + c1 - 1


'Print A matrix below used range
ws.Cells(r2 + 2, c1).Value = "A MATRIX"
ws.Cells(r2 + 2, c1).Font.Bold = True

ws.Cells(r2 + 2, c1 + NumberOfQualities + 2).Value = "A TRANSPOSE MATRIX"
ws.Cells(r2 + 2, c1 + NumberOfQualities + 2).Font.Bold = True


Set rng = Range(Cells(r2 + 3, c1), Cells(r2 + 3 + NumberOfCampaigns - 1, c1 + NumberOfQualities - 1))
Arng.Copy rng
rng.BorderAround LineStyle:=xlContinuous, Weight:=xlThin


'Initialize array A with values from range Arng
For i = 1 To NumberOfCampaigns
For j = 1 To NumberOfQualities
A(i, j) = Arng(i, j)
Next j
Next i


ATRANSPOSE = WorksheetFunction.Transpose(A)

r1 = r2 + 3
c1 = c1 + NumberOfQualities + 1
r2 = r2 + 3 + NumberOfQualities - 1
c2 = c1 + NumberOfCampaigns - 1

Set ATRANSPOSErng = Range(Cells(r1, c1), Cells(r2, c2))

For i = 1 To NumberOfQualities
For j = 1 To NumberOfCampaigns
ATRANSPOSErng(i, j) = ATRANSPOSE(i, j)
Next j
Next i


ATRANSPOSErng.Select
Selection.BorderAround LineStyle:=xlContinuous, Weight:=xlThin

'Get used range
Set rng = ws.UsedRange

'Print B next to A TRANSPOSE
ws.Cells(r1 - 1, c2 + 2).Value = "b MATRIX"
ws.Cells(r1 - 1, c2 + 2).Font.Bold = True

For i = 1 To NumberOfCampaigns
ActiveSheet.Cells(r1 + i - 1, c2 + 2).Value = 1
B(i, 1) = 1#
Next i
BTRANSPOSE = WorksheetFunction.Transpose(B)

Set Brng = Range(Cells(r1, c2 + 2), Cells(r1 + NumberOfCampaigns - 1, c2 + 2))
Brng.BorderAround LineStyle:=xlContinuous, Weight:=xlThin

' 'Print ATRANA next to ATRAN
Set rng = ws.UsedRange
r1 = rng.Row
r2 = rng.Rows.Count + r1 - 1
c1 = rng.Column
c2 = rng.Columns.Count + c1 - 1
ws.Cells(r2 + 2, c1).Value = "PRODUCT OF A TRANSPOSE AND A"
ws.Cells(r2 + 2, c1).Font.Bold = True

ATRANSPOSEA = WorksheetFunction.MMult(ATRANSPOSE, A)

Set ATRANSPOSEArng = Range(Cells(r2 + 3, c1), Cells(r2 + 3 + NumberOfQualities - 1, c1 + NumberOfQualities - 1))

For i = 1 To NumberOfQualities
For j = 1 To NumberOfQualities
ATRANSPOSEArng(i, j) = ATRANSPOSEA(i, j)
Next j
Next i

ATRANSPOSEArng.Select
Selection.BorderAround LineStyle:=xlContinuous, Weight:=xlThin

' Print ATRANSPOSE b next to ATRANSPOSEA
ws.Cells(r2 + 2, c1 + NumberOfQualities + 1).Value = "PRODUCT OF A TRANSPOSE AND b"
ws.Cells(r2 + 2, c1 + NumberOfQualities + 1).Font.Bold = True
ATRANSPOSEB = WorksheetFunction.MMult(ATRANSPOSE, B)
Set ATRANSPOSEBrng = Range(Cells(r2 + 3, c1 + NumberOfQualities + 1), Cells(r2 + 3 + NumberOfQualities - 1, c1 + NumberOfQualities + 1))
For i = 1 To NumberOfQualities
ATRANSPOSEBrng(i) = ATRANSPOSEB(i, 1)
Next i

ATRANSPOSEBrng.Select
Selection.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
Set rng = ws.UsedRange
r1 = rng.Row
r2 = rng.Rows.Count + r1 - 1
c1 = rng.Column
c2 = rng.Columns.Count + c1 - 1

ws.Cells(r2 + 2, c1).Value = "CONSUMPTION OF REFRACTORY MATERIAL PER TONNE OF EACH QUALITY"
ws.Cells(r2 + 2, c1).Font.Bold = True
Set Xrng = Range(Cells(r2 + 3, c1), Cells(r2 + 3, c1 + NumberOfQualities - 1))
Xrng.Select
Xrng.BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color:=vbRed
' Initialize array X to zeros
For i = 1 To NumberOfQualities
Xrng(1, i) = i / NumberOfQualities
X(1, i) = Xrng(1, i)
Next i
ws.Cells(r2 + 2, c1 + NumberOfQualities + 1).Value = "Objective Function"
ws.Cells(r2 + 2, c1 + NumberOfQualities + 1).Font.Bold = True

' Initialize objective function cell with formula intact.:banghead:
' The FormulaArray requires R1C1 notation. There is a range.Address
' property that returns the R1C1 coordinates for the particular range in quotes.

ws.Cells(r2 + 3, c1 + NumberOfQualities + 1).Select
Selection.FormulaArray = WorksheetFunction.MMult(Xrng, Application.WorksheetFunction.MMult(ATRANSPOSEArng, Application.WorksheetFunction.Transpose(Xrng)))
Selection.BorderAround LineStyle:=xlDouble
ws.Cells(r2 + 4, c1 + NumberOfQualities + 1).Select
Selection.FormulaArray = WorksheetFunction.MMult(Xrng, ATRANSPOSEBrng)
Selection.BorderAround LineStyle:=xlDouble


Set rng = ws.UsedRange
r1 = rng.Row
r2 = rng.Rows.Count + r1 - 1
c1 = rng.Column
c2 = rng.Columns.Count + c1 - 1
ws.Cells(r2 + 2, c1).Value = "X CONSTRAINED TO BE POSITIVE"
ws.Cells(r2 + 2, c1).Font.Bold = True

Set Constraintrng = Range(Cells(r2 + 3, c1), Cells(r2 + 3 + NumberOfQualities - 1, c1 + 2))
Constraintrng.Select

For i = 1 To NumberOfQualities
Constraintrng(i, 1).Formula = Xrng(1, i)
Constraintrng(i, 2) = ">="
Constraintrng(i, 3) = 0.001
Next i
Selection.BorderAround LineStyle:=xlContinuous, Weight:=xlThin, Color:=vbBlue
Exit Sub

' Calls to the Solver family of functions with the correct arguments.
'
' A path reference to the add-in location is available for these calls.
' MaxMinVal in SolverOk(SetCell, MaxMinVal, ValueOf, ByChange) calls can take on the following values
' 1 is maximize
' 2 is minimize
' 3 is match a value
' Relation in SolverAdd(cellref, Relation, Formulatext) calls can taken on the following values
' 1 is <=
' 2 is =
' 3 is >=
' 4 is integer valued
' 5 is binary valued
'

SolverOk SetCell:=Selection.Address, MaxMinVal:=2, ValueOf:="0", ByChange:=Xrng.Address
For i = 1 To NumberOfQualities
SolverAdd CellRef:=Constraintrng(i, 1).Address, Relation:=3, FormulaText:=Constraintrng(i, 3).Address
Next i
SolverOptions MaxTime:=100, Iterations:=100, Precision:=0.000001, AssumeLinear _
:=False, StepThru:=False, Estimates:=1, Derivatives:=1, SearchOption:=1, _
IntTolerance:=5, Scaling:=False, Convergence:=0.0001, AssumeNonNeg:=True
SolverSolve
End Sub


-----
Module1 code:



Option Explicit
Option Compare Binary
Public Const MaxCampaigns = 10
Public Const MaxQualities = 30
Public NumberOfCampaigns As Integer
Public NumberOfQualities As Integer
Public ATRANSPOSErng As Range
Public Arng As Range
Public Brng As Range
Public Xrng As Range
Public ATRANSPOSEArng As Range
Public ATRANSPOSEBrng As Range
Public Constraintrng As Range
Public ATRANSPOSE() As Variant
Public A() As Variant
Public ATRANSPOSEA() As Variant
Public B() As Variant
Public BTRANSPOSE() As Variant
Public ATRANSPOSEB() As Variant
Public XATRANSPOSEB() As Variant
Public X() As Variant