Aussiebear
04-05-2024, 11:45 PM
Its an arbitrary thing i guess, but when should code be broken down into sub modules? Listed below is a section of code that had been presented to this forum back in 2009. Not only is it very busy with its intentions, but from a coders point of view would you attempt something like this?
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
How should this be handled?
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
How should this be handled?