VBA Solver Add-in for several continuous rows in a loop or similar

H

hakonmar

New Member
Joined
Mar 17, 2010
Messages
14
Hi!

I have made an iterative process in VBA, which gives the angle of a perfect circular circle between to points with North South coordinates(X) and East West coordinates(Y). The Depth is of no interest in this case, so there is no Z coordinate.

What I need is the solver to do is continue down i = i+1, meaning the constraints change down one cell as well as the target cell and the cell needed for change. In this case the target cell and the cell needed for change is the same.

The code is here and is written in excel2007, meaning the add-in for solver is written like "solver.xlam".

Code: 
Private Sub CommandButton1_Click()
SolverMacro
End Sub

Sub CheckCells()
    Dim Data As Range
        For Each Data In Range("A1:B20")
        If IsEmpty(Data.Value) Then
            ElseIf WorksheetFunction.IsText(Data.Value) Then
            MsgBox "There is text written in the cells - remove!!!"
            ElseIf WorksheetFunction.IsNumber(Data.Value) Then
            SolverMacro
        End If
        Next Data
End Sub

Sub SolverMacro()
Application.Run "solver.xlam!Solver.Solver2.Auto_open"
Application.Run "SolverReset"
Application.Run "SolverAdd", "E3", 1, "F3"
Application.Run "SolverOk", "G3", 1, "0", "G3"
Application.Run "SolverSolve", True
End Sub
[\code]

This code in Solver says E3=F3 by changing G3 to achieve the angle and place it in G3. This happens when the commandbutton1_click is run, and the cell is not empty by initiating the CheckCells(), which again starts the SolverMacro()  routine.

E3=(X-Xo)/(Y-Yo)  ->where X is the new coordinate while Xo is the one before, and the same for Y and Yo. Xo is C2, X is C3, Yo is D2, Y is D3

F3 = (sinφ-sinφo)/ (cosφ-cosφo) -> where φ is the angle corrospondent with  the coordinate of X and Y, and φo is corrospondent with the coordinates Xo and Yo. φo is the known cell G2 and φ is the iterative solution G3 of the angle for the circular arc between the two points.

So the solver changes G3 till E3=F3 and thus making it an iterative solution. How can I make the code so that it continues to calculate E4=F4 by changing G4. Have tried making an object and doing i = i+1, but I fail again and again. Maybe some of you have a solution? I could make a commandbutton for each row, but I have like 40 rows, so I would very much like to have only one commandbutton doing the CheckCell() and when there is a number inside the X and Y the SolverMacro() is initiated. Any suggestions?? 

Hope I am explaining well enough what I want? The way I see it is the SolverMacro() which need to be changed, with some i = i+1 and so forth.... Hope you could help me. I am really stuck here and it would simplify my workbook a lot!

Greetings from Norway:)

Haakon Martin
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
I don't follow all of what you are doing here but maybe something like this will give you an idea of how it could be done...

Code: 
Private Sub CommandButton1_Click()
 Dim cell As Range
 
[COLOR="Red"] For Each cell In Range("E3:E43")[/COLOR]
    SolverMacro [COLOR="red"](cell)[/COLOR]
[COLOR="red"] Next cell[/COLOR]
 
End Sub

Sub CheckCells()
Dim Data As Range
For Each Data In Range("A1:A20")
If IsEmpty(Data.Value) Or IsEmpty(Data.Offset(0, 1).Value) Then
ElseIf WorksheetFunction.IsText(Data.Value) Or WorksheetFunction.IsText(Data.Value) Then
MsgBox "There is text written in the cells - remove!!!"
ElseIf IsNumeric(Data.Value) Or IsNumeric(Data.Offset(0, 1).Value) Then
SolverMacro (Data)
End If
Next Data
End Sub

Sub SolverMacro([COLOR="red"]rng As Range[/COLOR])
Application.Run "solver.xlam!Solver.Solver2.Auto_open"
Application.Run "SolverReset"
Application.Run "SolverAdd", [COLOR="red"]rng.Address[/COLOR], 1, [COLOR="red"]rng.Offset(0, 1).Address[/COLOR]
Application.Run "SolverOk", [COLOR="red"]rng.Offset(0, 2).Address[/COLOR], 1, "0", [COLOR="red"]rng.Offset(0, 2).Address[/COLOR]
Application.Run "SolverSolve", True
End Sub
 
Upvote 0
Sorry! I had given the code with a fault in the commandbutton it should call on the CheckCells sub routine giving this code:

Code: 
Private Sub CommandButton1_Click()
CheckCells
End Sub

Sub CheckCells()
    Dim Data As Range
        For Each Data In Range("A1:B20")
        If IsEmpty(Data.Value) Then
            ElseIf WorksheetFunction.IsText(Data.Value) Then
            MsgBox "Text in boxes"
            ElseIf WorksheetFunction.IsNumber(Data.Value) Then
            SolverMacro
        End If
        Next Data
End Sub

Sub SolverMacro()
Application.Run "solver.xlam!Solver.Solver2.Auto_open"
Application.Run "SolverReset"
Application.Run "SolverAdd", "E9", 1, "E12"
Application.Run "SolverOk", "G3", 1, "0", "G3"
Application.Run "SolverSolve", True
End Sub
[\code]

Now you say you do not fully follow, but I will try out the tips you gave me, and see whether you have:) I hope it does!!:)

Kind regards

Haakon Martin
 
Upvote 0
Should be E3 instead of E9 , and F3 instead of E12 in the code:)


hakonmar said:
Sorry! I had given the code with a fault in the commandbutton it should call on the CheckCells sub routine giving this code:

Code: 
Private Sub CommandButton1_Click()
CheckCells
End Sub

Sub CheckCells()
    Dim Data As Range
        For Each Data In Range("A1:B20")
        If IsEmpty(Data.Value) Then
            ElseIf WorksheetFunction.IsText(Data.Value) Then
            MsgBox "Text in boxes"
            ElseIf WorksheetFunction.IsNumber(Data.Value) Then
            SolverMacro
        End If
        Next Data
End Sub

Sub SolverMacro()
Application.Run "solver.xlam!Solver.Solver2.Auto_open"
Application.Run "SolverReset"
Application.Run "SolverAdd", "E3", 1, "F3"
Application.Run "SolverOk", "G3", 1, "0", "G3"
Application.Run "SolverSolve", True
End Sub
[\code]

Now you say you do not fully follow, but I will try out the tips you gave me, and see whether you have:) I hope it does!!:)

Kind regards

Haakon Martin[/QUOTE]
Click to expand...
 
Upvote 0
This code worked perfectly when modifying what you wrote. The thing is that the "rng"-object" gave a no defined statement and a argument not optional when inside the: SolverMacro(rng As Range). So whether or not this code is the best - it works:) I have also changed the MsgBox text, so that it returns the actual cell where text is written. My programming skills are developing slowly but well I believe:)

Code: 
Private Sub CommandButton1_Click()
CheckCells
End Sub

Sub CheckCells()
    Dim Data As Range
        For Each Data In Range("A1:B20")
        If IsEmpty(Data.Value) Then
        ElseIf WorksheetFunction.IsText(Data.Value) Then
        MsgBox "Remove the text in cell" & Chr(2) & Data.Row & vbNewLine _
        & "Leave it blank or insert a coordinate"
        ElseIf WorksheetFunction.IsNumber(Data.Value) Then
        SolverMacro
        End If
        Next Data
End Sub

Public Sub SolverMacro()
Dim rng As Range
For Each rng In Range("E3:E5")
Application.Run "solver.xlam!Solver.Solver2.Auto_open"
Application.Run "SolverReset"
Application.Run "SolverAdd", rng.Address, 1, rng.Offset(0, 1).Address
Application.Run "SolverOk", rng.Offset(0, 2).Address, 1, "0", rng.Offset(0, 2).Address
Application.Run "SolverSolve", True
Next rng
End Sub

Thanks a lot for the help!
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Issues looping through excel data range when blank rows/cells are introduced.
Replies
6
Views
542
Skyybot
Skyybot
J
  • Question
Move Table Row to Another Sheet
Replies
6
Views
531
jessebh2003
J
deadlyjack
  • Solved
If / Loop / Merge
2
Replies
12
Views
1K
maabadi
M
G
  • Solved
Loop Calculate and paste results in consecutive rows
Replies
4
Views
2K
GeeWhiz7
G
E
  • Solved
How to find a data anomaly in a row
2
Replies
11
Views
865
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,214,932
Messages
6,122,334
Members
449,077
Latest member
Jocksteriom

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