Goal seek using macro

promise899

New Member
Joined
Feb 18, 2022
Messages
9
Office Version
  1. 2016
Platform
  1. Windows
I have transposed a formula that has the same variable on both sides of the equation, thus producing two separate equations that equal each other.

For the first iteration, I find f value using goal seek tool.

each iteration(2,3,4,5) I want to use goal seek tools in order to find f values. After finding f value I can find Cchezy and Vnew because it depends on f value as can be seen from excel sheet.

Iteration continues until V and Vnew value be equal. I think to use assing macro to button in order to use goal seek tool each times . But I cant find how to do it? Thank you.

soru1.xlsx
ABCDEF
10.015974<<--Value of fd=0.50m
2b=10.00m
3L.H.SR.H.SL.H.S-R.H.SJ=0.002
47.9120357.9116410.000394221ks=0.01mm
5
6θ=0.002
7V=0.10
8DH=1.818182
9Re=181818.2
10
11
12IterationV(m/s)fCchezyVnew(m/s)
1310.10.01670.091880.279196552
1420.279197
153
164
175
Sayfa1
Cell Formulas
RangeFormula
A4A4=1/SQRT(B1)
B4B4=-2*LOG10((F4*0.001/3.71/F8)+(2.51)/F9/SQRT(B1))
C4C4=A4-B4
F8F8=4*(F1*F2)/(2*F1+F2)
F9F9=(1000*F7*F8)/0.001
C13C13=B1
D13D13=SQRT(8*9.81/B1)
E13E13=D13*SQRT(0.25*F8*SIN(RADIANS(F6)))
B14B14=E13
 

Attachments

  • 1.jpg
    1.jpg
    81.5 KB · Views: 13

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
I cant edit first message but I need to indicate that for each Vnew value, Re and R.H.S values also be changed.
 
Upvote 0
i don't know what you do after an iteration, but this can give you an idea
VBA Code:
Sub Promise()
     For i = 1 To 4                                             ' 4 iterations
          Range("C4").GoalSeek Goal:=0, ChangingCell:=Range("B1")     'your goalseek
          With Range("B13:E13")                                 'the wanted results are in B13:E13
               .Offset(i).Value = .Value                        'copy them hardcoded to the 4 next lines
          End With
          MsgBox "now do something before the next iteration", vbInformation
     Next
End Sub
 
Upvote 0
i don't know what you do after an iteration, but this can give you an idea
VBA Code:
Sub Promise()
     For i = 1 To 4                                             ' 4 iterations
          Range("C4").GoalSeek Goal:=0, ChangingCell:=Range("B1")     'your goalseek
          With Range("B13:E13")                                 'the wanted results are in B13:E13
               .Offset(i).Value = .Value                        'copy them hardcoded to the 4 next lines
          End With
          MsgBox "now do something before the next iteration", vbInformation
     Next
End Sub
Your code is well but for each iteration V values should be changed. but in your codes it is constant for each step.

For clarify I uploaded video about which I am trying to do.

 
Upvote 0
Your code is well but for each iteration V values should be changed. but in your codes it is constant for each step.

For clarify I uploaded video about which I am trying to do.

soru1.xlsx
ABCDEFGHIJKLM
10.012965<<--Value of fd=0.50m
2b=10.00m
3L.H.SR.H.SL.H.S-R.H.SJ=0.002
48.782258.782291-4.17921E-05ks=0.01mm
5
6θ=0.002
7V=0.31
8DH=1.818182
9Re=563076.6
10
11
12IterationV(m/s)fCchezyVnew(m/s)IterationV(m/s)fCchezyVnew(m/s)
1310.310.01377.801020.30990430910.10.01670.08870.279183873
14220.2791840.01320377.098380.307105503
15330.3071060.01298377.747750.309692126
16440.3096920.01296577.801020.309904309
1755
18
Sayfa1
Cell Formulas
RangeFormula
A4A4=1/SQRT(B1)
B4B4=-2*LOG10((F4*0.001/3.71/F8)+(2.51)/F9/SQRT(B1))
C4C4=A4-B4
F8F8=4*(F1*F2)/(2*F1+F2)
F9F9=(1000*F7*F8)/0.001
B13B13=F7
C13C13=B1
D13D13=SQRT(8*9.81/C13)
E13E13=D13*SQRT(0.25*F8*SIN(RADIANS(F6)))
 
Upvote 0
VBA Code:
Sub Promise()
     
     Set c = Range("J13") 'topleft-cell writing iteration results
     c.Resize(10, 4).ClearContents

     For i = 1 To 10                                            'max 10 iterations
          Range("C4").GoalSeek Goal:=0, ChangingCell:=Range("B1")     'your goalseek
          With Range("B13:E13")                                 'the wanted results are in B13:E13
               c.Resize(, 4).Offset(i - 1).Value = .Value       'copy them hardcoded to the 4 next lines
          End With

          If Abs(Range("F7").Value - Range("E13").Value) < 0.00001 Then     'difference between old and new v less than ...
               Exit For                                         'stop looping
          Else
               Range("F7").Value = Range("E13").Value           'new V
          End If
     Next
End Sub
 
Upvote 0
VBA Code:
Sub Promise()
    
     Set c = Range("J13") 'topleft-cell writing iteration results
     c.Resize(10, 4).ClearContents

     For i = 1 To 10                                            'max 10 iterations
          Range("C4").GoalSeek Goal:=0, ChangingCell:=Range("B1")     'your goalseek
          With Range("B13:E13")                                 'the wanted results are in B13:E13
               c.Resize(, 4).Offset(i - 1).Value = .Value       'copy them hardcoded to the 4 next lines
          End With

          If Abs(Range("F7").Value - Range("E13").Value) < 0.00001 Then     'difference between old and new v less than ...
               Exit For                                         'stop looping
          Else
               Range("F7").Value = Range("E13").Value           'new V
          End If
     Next
End Sub
Thanks For iteration table, dont need to copy to 4 next lines I did thing for showing that. (it can be start from B13 dont copy please)

Also this makro only give last row of the table. I need all row and column of the table as in photo . Thank you very much
 

Attachments

  • 1.png
    1.png
    16.1 KB · Views: 12
Upvote 0
VBA Code:
Sub Promise()
     Range("I1").Resize(, 6).EntireColumn.ClearContents
     Set c2 = Range("A1:F13")                                   'block to copy

     For i = 1 To 10                                            'max 10 iterations
          Range("C4").GoalSeek Goal:=0, ChangingCell:=Range("B1")     'your goalseek

          Set c1 = Range("I" & Rows.Count).End(xlUp).Offset(2)  'next free line
          c1.Value = "iteration " & i                           'write iteration
          c1.Offset(1).Resize(c2.Rows.Count, c2.Columns.Count).Value = c2.Value     'hardcopy of block
          c1.Offset(c2.Rows.Count + 2).Value = "end"            'mark end

          If Abs(Range("F7").Value - Range("E13").Value) < 0.00001 Then     'difference between old and new v less than ...
               Exit For                                         'stop looping
          Else
               Range("F7").Value = Range("E13").Value           'new V
          End If
     Next
     c1.Resize(, 6).EntireColumn.AutoFit

End Sub
 
Upvote 0
VBA Code:
Sub Promise()
     Range("I1").Resize(, 6).EntireColumn.ClearContents
     Set c2 = Range("A1:F13")                                   'block to copy

     For i = 1 To 10                                            'max 10 iterations
          Range("C4").GoalSeek Goal:=0, ChangingCell:=Range("B1")     'your goalseek

          Set c1 = Range("I" & Rows.Count).End(xlUp).Offset(2)  'next free line
          c1.Value = "iteration " & i                           'write iteration
          c1.Offset(1).Resize(c2.Rows.Count, c2.Columns.Count).Value = c2.Value     'hardcopy of block
          c1.Offset(c2.Rows.Count + 2).Value = "end"            'mark end

          If Abs(Range("F7").Value - Range("E13").Value) < 0.00001 Then     'difference between old and new v less than ...
               Exit For                                         'stop looping
          Else
               Range("F7").Value = Range("E13").Value           'new V
          End If
     Next
     c1.Resize(, 6).EntireColumn.AutoFit

End Sub
Doesn t work:/

 
Upvote 0

Forum statistics

Threads
1,212,938
Messages
6,110,775
Members
448,298
Latest member
carmadgar

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