# Best Fit formula or VBA scenario

#### mahmed1

##### Well-known Member
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

#### mahmed1

##### Well-known Member
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)

### Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

#### mahmed1

##### Well-known Member
Hi Matey - I ran again today but it was taking longer than normal but didn’t crash like over the weekend

#### mahmed1

##### Well-known Member
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

#### Eric W

##### MrExcel MVP
If you post your code, I'll take a look at it.

#### mahmed1

##### Well-known Member

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

#### mahmed1

##### Well-known Member
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"

SolverOk SetCell:=ChangesToMake, _
MaxMinVal:=2, _
ValueOf:=0, _
ByChange:=CriteriaRange, _
Engine:=1, _
EngineDesc:="Evolutionary"

SolverSolve
End Sub``````

#### mahmed1

##### Well-known Member

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"

SolverOk SetCell:=ChangesToMake, _
MaxMinVal:=2, _
ValueOf:=0, _
ByChange:=CriteriaRange, _
Engine:=1, _
EngineDesc:="Evolutionary"

SolverSolve
End Sub``````
And also i forgot to mention- i added the solver ref from vba tools ref else code wouldn’t run

#### mahmed1

##### Well-known Member
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) Required Available Req % 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) Required Available Req % 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​

#### mahmed1

##### Well-known Member
Here is the VBA Code

VBA Code:
``````Sub Solver()

Dim ws As Worksheet
Dim lRow As Long

Application.ScreenUpdating = False

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

SolverOk SetCell:=ChangesToMake, _
MaxMinVal:=2, _
ValueOf:=0, _
ByChange:=CriteriaRange, _
Engine:=1, _
EngineDesc:="GRG Nonlinear" 'Changed to Evolutionary too

SolverSolve
SolverReset

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub``````

#### mahmed1

##### Well-known Member
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

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

SolverOk SetCell:=ChangesToMake, _
MaxMinVal:=2, _
ValueOf:=0, _
ByChange:=CriteriaRange, _
Engine:=1, _
EngineDesc:="GRG Nonlinear"

SolverSolve
SolverReset

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub``````

Replies
0
Views
227
Replies
1
Views
648
Replies
8
Views
276
Replies
1
Views
215
Replies
1
Views
479

1,136,796
Messages
5,677,785
Members
419,720
Latest member
kurman

### 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.

### Which adblocker are you using?

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

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