Best Fit formula or VBA scenario

M

mahmed1

Well-known Member
Joined
Mar 28, 2009
Messages
2,302
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi All,

I hope you are well

I have a dataset that looks at what I require and how much I have available.

The % Of Total Requirement is the interval value over the total requirement for the day (Formula copied down =(F22/F$55)*100
The % Of % Of Total Available is the interval value over the total available for the day =(I22/I$55)*100

I then have a variance to see how far I am away from requirement =(AB22-AA22)/AA22

What I want to be able to do is set a target of either -20% or 20%. I want the variance to see how far I am away from requirement to be within that target spread across the day by changing the Availability

E.g I want to be able to spread out the availability across the day to get the % variance away from the target to be within my target (The aim is to evenly spread out the intervals within the target)
So a bit like the goal seek to change every value but spread out equally if that makes sense

It might be complexed formula or VBA approach

Hopefully someone can help me give a best fit scenario - Thank You So Much
 
Sort by date Sort by votes
Hi Buddy, I ran the solver and it worked the first time but now for some reason it keeps crashing on me and kicks me out of excel

maybe im doing something wrong or maybe somehow i need to limit the number of checks (im not sure how and if thats the case)

appreciate your help matey
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Hi Matey - I ran again today but it was taking longer than normal but didn’t crash like over the weekend
 
Upvote 0
In regards to VBA side of it i managed to find a way to record and make dynamic however re crashing or minimising the possibilities re my boundaries is still a slight issue if not

hopefully you can help me tweak it slightly to possible over come this

thank you
 
Upvote 0
Thank you - ill post the recorded macro
I didnt make the full amendments purely because i thought id follow ur advice and get the whole scenario right first by minimising to fit if boundaries not met etc
and the fact it crashes sometimes or takes a lil longer

i dont have access to a computer but as soon as i do il post code

thank you again
 
Upvote 0
Hi Eric,

I get an error msg saying in error in Model - please verify that cells and constraints are valid

It crashes now all the time if i run it without the code (ie followed the exact steps and it does something and then crashes)

VBA Code: 
Sub Solver()

Dim ws As Worksheet
Dim lRow As Long

Set ws = ThisWorkbook.Worksheets("Data")
lRow = ws.Range("B" & Rows.Count).End(xlUp).Row

ChangeCell = ws.Range("Q17")
CriteriaRange = ws.Range("L4:L" & lRow)
ChangeRange = ws.Range("O4:O" & lRow)
RequiredRange = ws.Range("K4:K" & lRow)
LowerBoundary = ws.Range("N1")
UpperBoundary = ws.Range("O1")
RevisedAvilableTotal = ws.Range("L17")
OriginalAvilableTotal = ws.Range("D17")
ChangesToMake = ws.Range("Q17")

    SolverOk SetCell:=ChangeCell, _
                      MaxMinVal:=2, _
                      ValueOf:=0, _
                      ByChange:=CriteriaRange, _
                      Engine:=1, _
                      EngineDesc:="Evolutionary"
    
    SolverAdd CellRef:=RevisedAvilableTotal, Relation:=2, FormulaText:=OriginalAvilableTotal
    SolverAdd CellRef:=CriteriaRange, Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=CriteriaRange, Relation:=1, FormulaText:=RequiredRange
    SolverAdd CellRef:=CriteriaRange, Relation:=4, FormulaText:="integer"
    SolverAdd CellRef:=ChangeRange, Relation:=3, FormulaText:=LowerBoundary
    SolverAdd CellRef:=ChangeRange, Relation:=1, FormulaText:=UpperBoundary
    
    SolverOk SetCell:=ChangesToMake, _
                      MaxMinVal:=2, _
                      ValueOf:=0, _
                      ByChange:=CriteriaRange, _
                      Engine:=1, _
                      EngineDesc:="Evolutionary"

    
    SolverSolve
End Sub
 
Upvote 0
mahmed1 said:
Hi Eric,

I get an error msg saying in error in Model - please verify that cells and constraints are valid

It crashes now all the time if i run it without the code (ie followed the exact steps and it does something and then crashes)

VBA Code: 
Sub Solver()

Dim ws As Worksheet
Dim lRow As Long

Set ws = ThisWorkbook.Worksheets("Data")
lRow = ws.Range("B" & Rows.Count).End(xlUp).Row

ChangeCell = ws.Range("Q17")
CriteriaRange = ws.Range("L4:L" & lRow)
ChangeRange = ws.Range("O4:O" & lRow)
RequiredRange = ws.Range("K4:K" & lRow)
LowerBoundary = ws.Range("N1")
UpperBoundary = ws.Range("O1")
RevisedAvilableTotal = ws.Range("L17")
OriginalAvilableTotal = ws.Range("D17")
ChangesToMake = ws.Range("Q17")

    SolverOk SetCell:=ChangeCell, _
                      MaxMinVal:=2, _
                      ValueOf:=0, _
                      ByChange:=CriteriaRange, _
                      Engine:=1, _
                      EngineDesc:="Evolutionary"
   
    SolverAdd CellRef:=RevisedAvilableTotal, Relation:=2, FormulaText:=OriginalAvilableTotal
    SolverAdd CellRef:=CriteriaRange, Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=CriteriaRange, Relation:=1, FormulaText:=RequiredRange
    SolverAdd CellRef:=CriteriaRange, Relation:=4, FormulaText:="integer"
    SolverAdd CellRef:=ChangeRange, Relation:=3, FormulaText:=LowerBoundary
    SolverAdd CellRef:=ChangeRange, Relation:=1, FormulaText:=UpperBoundary
   
    SolverOk SetCell:=ChangesToMake, _
                      MaxMinVal:=2, _
                      ValueOf:=0, _
                      ByChange:=CriteriaRange, _
                      Engine:=1, _
                      EngineDesc:="Evolutionary"

   
    SolverSolve
End Sub
Click to expand...
And also i forgot to mention- i added the solver ref from vba tools ref else code wouldn’t run
 
Upvote 0
Hi @Eric W

Firstly want to say thank you so much - ben a great help and your patience is much appreciated

So i managed to get the code working although i could not find anyway of disabling the pop up msg box

Few Qs
----- Is there a way i can get the available to be a whole number as opposed to having a decimal?
---- How can i overcome the msgbox pop ups?
---- Which is better and quicker to use (Evolutionary or GRG Nonlinear)?

So when i use Evolutionary - i get several of pop ups saying max number has been reached, do you want to continue - i can carry on pressing continue and each time it does improve it but it takes forever(I guess for now is just making sure i am within the boundaries although it may not be best fit meeting all criterias and availability if possible being whole numbers as availability is in heads)

If I use GRG Nonlinear it does not take long at all to run but i dont know if that would work with all examples so not sure which to use

Please see results and outcome below

Evolutionary = 1st STOP (I Can continue but takes forever)
RequiredAvailableReq %Ava %Ind %Revised Numbers
08:00​
7​
5.33
2.22%​
2.67%​
20.000000%​
1​
1​
08:30​
29​
16.63
9.21%​
8.32%​
-9.655172%​
-8​
8​
09:00​
5​
3.81
1.59%​
1.90%​
20.000000%​
1​
1​
09:30​
14​
10.67
4.44%​
5.33%​
20.000000%​
-1​
1​
10:00​
24​
18.29
7.62%​
9.14%​
20.000000%​
0​
0​
10:30​
12​
9.14
3.81%​
4.57%​
20.000000%​
-2​
2​
11:00​
28​
21.33
8.89%​
10.67%​
20.000000%​
-5​
5​
11:30​
19​
14.48
6.03%​
7.24%​
20.000000%​
1​
1​
12:00​
24​
18.29
7.62%​
9.14%​
20.000000%​
-2​
2​
12:30​
17​
12.95
5.40%​
6.48%​
20.000000%​
5​
5​
13:00​
46​
23.37
14.60%​
11.68%​
-20.000000%​
3​
3​
13:30​
45​
22.86​
14.29%​
11.43%​
-20.000000%​
3​
3​
14:00​
45​
22.86​
14.29%​
11.43%​
-20.000000%​
3​
3​
315​
200.00​
36​



GRG Nonlinear (Doesn’t take long at all)
RequiredAvailableReq %Ava %Ind %Revised Numbers
08:00​
7​
5.09​
2.22%​
2.55%​
14.629773%​
1​
1​
08:30​
29​
22.10​
9.21%​
11.05%​
20.000000%​
-3​
3​
09:00​
5​
3.21​
1.59%​
1.61%​
1.221725%​
0​
0​
09:30​
14​
10.67​
4.44%​
5.33%​
20.000000%​
-1​
1​
10:00​
24​
18.29​
7.62%​
9.14%​
20.000000%​
0​
0​
10:30​
12​
9.14​
3.81%​
4.57%​
20.000000%​
-2​
2​
11:00​
28​
21.33​
8.89%​
10.67%​
20.000000%​
-5​
5​
11:30​
19​
14.17​
6.03%​
7.08%​
17.446472%​
1​
1​
12:00​
24​
18.29​
7.62%​
9.14%​
20.000000%​
-2​
2​
12:30​
17​
8.63​
5.40%​
4.32%​
-20.000000%​
1​
1​
13:00​
46​
23.37​
14.60%​
11.68%​
-20.000000%​
3​
3​
13:30​
45​
22.86​
14.29%​
11.43%​
-20.000000%​
3​
3​
14:00​
45​
22.86​
14.29%​
11.43%​
-20.000000%​
3​
3​
315​
200.00​
25​
 
Upvote 0
Here is the VBA Code

VBA Code: 
Sub Solver()

Dim ws As Worksheet
Dim lRow As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set ws = ThisWorkbook.Worksheets("Data")
lRow = ws.Range("B" & Rows.Count).End(xlUp).Row

ChangeCell = ws.Range("Q17").Address
CriteriaRange = ws.Range("L4:L" & lRow).Address
ChangeRange = ws.Range("O4:O" & lRow).Address
RequiredRange = ws.Range("K4:K" & lRow).Address
LowerBoundary = ws.Range("N1").Address
UpperBoundary = ws.Range("O1").Address
RevisedAvilableTotal = ws.Range("L17").Address
OriginalAvilableTotal = ws.Range("D17").Address
ChangesToMake = ws.Range("Q17").Address

    
    SolverAdd CellRef:=RevisedAvilableTotal, Relation:=2, FormulaText:=OriginalAvilableTotal
    SolverAdd CellRef:=CriteriaRange, Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=CriteriaRange, Relation:=1, FormulaText:=RequiredRange
    SolverAdd CellRef:=CriteriaRange, Relation:=4, FormulaText:="integer"
    SolverAdd CellRef:=ChangeRange, Relation:=3, FormulaText:=LowerBoundary
    SolverAdd CellRef:=ChangeRange, Relation:=1, FormulaText:=UpperBoundary
    
    SolverOk SetCell:=ChangesToMake, _
                      MaxMinVal:=2, _
                      ValueOf:=0, _
                      ByChange:=CriteriaRange, _
                      Engine:=1, _
                      EngineDesc:="GRG Nonlinear" 'Changed to Evolutionary too

    Application.DisplayAlerts = True
    
    SolverSolve
    SolverReset
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
 
Upvote 0
It wont let me edit the VBA Code but i did infact change the display alerts to the end

VBA Code: 
Sub Solver()

Dim ws As Worksheet
Dim lRow As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set ws = ThisWorkbook.Worksheets("Data")
lRow = ws.Range("B" & Rows.Count).End(xlUp).Row

ChangeCell = ws.Range("Q17").Address
CriteriaRange = ws.Range("L4:L" & lRow).Address
ChangeRange = ws.Range("O4:O" & lRow).Address
RequiredRange = ws.Range("K4:K" & lRow).Address
LowerBoundary = ws.Range("N1").Address
UpperBoundary = ws.Range("O1").Address
RevisedAvilableTotal = ws.Range("L17").Address
OriginalAvilableTotal = ws.Range("D17").Address
ChangesToMake = ws.Range("Q17").Address

    
    SolverAdd CellRef:=RevisedAvilableTotal, Relation:=2, FormulaText:=OriginalAvilableTotal
    SolverAdd CellRef:=CriteriaRange, Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=CriteriaRange, Relation:=1, FormulaText:=RequiredRange
    SolverAdd CellRef:=CriteriaRange, Relation:=4, FormulaText:="integer"
    SolverAdd CellRef:=ChangeRange, Relation:=3, FormulaText:=LowerBoundary
    SolverAdd CellRef:=ChangeRange, Relation:=1, FormulaText:=UpperBoundary
    
    SolverOk SetCell:=ChangesToMake, _
                      MaxMinVal:=2, _
                      ValueOf:=0, _
                      ByChange:=CriteriaRange, _
                      Engine:=1, _
                      EngineDesc:="GRG Nonlinear"


    SolverSolve
    SolverReset
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Excel Blood Pressure & Heart Rate AVG?
2
Replies
14
Views
3K
Dave Patton
D
L
  • Solved
SUMIFS formula possible with current worksheet formatting?
Replies
4
Views
283
duggie33
D
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
395
AndyEd
A
P
  • Question
variable List creation
Replies
0
Views
314
Pheonix2332
P
F
  • Question
Formula with conditions of 7 days
Replies
9
Views
268
SanjayGMusafir
SanjayGMusafir

Forum statistics

Threads
1,214,875
Messages
6,122,037
Members
449,062
Latest member
mike575

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top