How to resolve this Wend without while error?

Y

Yashraj Jadhao

New Member
Joined
Nov 14, 2021
Messages
9
Office Version
  1. 2021
Platform
  1. MacOS
I am getting compile error: Wend without While but clearly I have mentioned it. How to resolve this error
VBA Code: 
Sub Button1_Click()
'To ask user for highest exponent and dimension coefficient variables
highestexponent = InputBox("Input largest exponent in f(x).")
Dim coefficient(1000) As Double
'To ask user for coefficient values
For counter = 0 To highestexponent
coefficient(counter) = InputBox("Input coefficients on the x^" & counter)
Next counter
'To define the function f(x)
functionstring = "f(x)="
For counter = highestexponent To 0 Step -1
If counter > 0 Then
functionstring = functionstring & coefficient(counter) & "xˆ " & counter & " + "
Else
functionstring = functionstring & coefficient(counter) & "xˆ " & counter
End If
Next counter
Cells(2, 1) = functionstring
 
Dim xmin As Integer
Dim xmax As Integer
   
xmin = InputBox("Input a lower bound x value to be evaluated in f(x) function.")
xmax = InputBox("Input a higher bound x value to be evaluated in f(x) function.")
'Cells(5,2) = xmin
'Cells(4,2)=xmax
   
Dim tolerance As Single
tolerance = InputBox("Input a tolernace value for thr root.")
'Cells(6,2)=root
'Cells(7,2)=tolernace
Dim functionvaluemin As Double
Dim functionvaluemax As Double
functionvaluemin = 0
functionvaluemax = 0
signdifference = 0
While signdifference = 0
   
For counter = 0 To highestexponent
functionvaluemax = functionvaluemax + coefficient(counter) * xmax ^ (counter)
Next counter
For counter2 = 0 To highestexponent
functionvaluemin = funcionvaluemin + coefficient(counter2) * xmin ^ (counter2)
Next counter2
'Cells(8,2)= functionvaluemax
'Cells(9,2)= functionvaluemin
If functionvaluemin > 0 And functionvaluemax > O Then
MsgBox ("There is no sign difference between f(xmin) and f(xmax). Input new values.")
xmin = InputBox("Input a lower bound x value to be evaluated in f(x) function.")
xmax = InputBox("Input a higher bound x value to be evaluated in f(x) function.")
ElseIf functionvaluemin < 0 And functionvaluemax < 0 Then
MsgBox ("There is no sign difference between f(xmin) and f(xmax). Input new values.")
xmin = InputBox("Input a lower bound x value to be evaluated in f(x) function.")
xmax = InputBox("Input a higher bound x value to be evaluated in f(x) function.")
   
Else
signdifference = 1
End If
Wend
Dim errormax As Double, trueroot As Double, xbisect As Double
Dim functionvaluexnewbisect As Double
xbisect = (xmin + xmax) / 2
'Cells(6,2)=xbisect
   
'Loop to solve for true root
signdifference = 0

While signdifference = 0

errormax = (xmax - xmin) / 2
'Cells(10,2)=errormax
xnewbisect = (xmin + xmax) / 2
'Cells(12,2)=xnewbisect
'To evaluate f(xmin), f(xmax), and f(newbisect)
functionvaluexnewbisect = 0
functionvaluexmin = 0
functionvaluemax = 0
For counter4 = 0 To highestexponent
functionvaluexnewbisect = functionvaluexnebisect + coefficient(counter4) * xnewbisect ^ (counter4)
Next counter4
For counter5 = 0 To highestexponent
functionvaluexmax = functionvaluexmax + coefficient(counter5) * xmax ^ (counter5)
Next counter5
   
For counter6 = 0 To highestexponent
functionvaluexmin = functionvaluexmin + coefficient(counter6) * xmin ^ (counter6)
  Next counter6
'Cells(13,2)= functionvaluexnewbisect
'Cells(14, 2) = functionvaluexmin
'Cells(15,2)=functionvaluemax
 'To replace xmin/xmax with xnewbisect
If errormax < tolerance Then
trueroot = xnewbisect
'Cells(11,2)=trueroot
 Stop
ElseIf functionvaluexnewbisect > 0 And functionvaluexmin > 0 Then
xmin = xnewbisect
ElseIf functionvaluexnewbisect < 0 And functionvaluexmin < 0 Then
xmin = xnewbisect
ElseIf functionvaluaexnewbiseet > 0 And functionvaluexmax > 0 Then
xmax = xnewbisect
ElseIf functionvaluexnewbisect < 0 And functionvaluexmin < 0 Then
xmax = xnewbisect
ElseIf functionvaluexmin = 0 Then
trueroot = xmin
Cells(11, 2) = trueroot
Stop
ElseIf functionvaluexmax = 0 Then
trueroot = xmax
Cells(11, 2) = trueroot
Stop
ElseIf functionvaluexnewbisect = 0 Then
trueroot = xnewbisect
Cells(11, 2) = trueroot
Stop
'Cells(13, 2)= functionvaluexnewbisect
'Cells (14,2)=functionvaluexmin
'Cells (15,2)=functionvaluexmax
'To replace xmin/xmax with xnewbisect
If errormax < tolerance Then
trueroot = xnewbisect
'Cells (11, 2) = trueroot
Stop
ElseIf functionvaluexnewbisect > 0 And functionvaluexmin > 0 Then
xmin = xnewbisect
ElseIf functionvaluexnewbisect < 0 And functionvaluexmin < 0 Then
xmin = xnewbisect
ElseIf functionvaluexnewbisect > 0 And functionvaluexmax > 0 Then
xmax = xnewbisect
ElseIf functionvaluexnewbisect < 0 And functionvaluexmax < 0 Then
xmax = newbisect
ElseIf functionvaluemin = 0 Then
trueroot = xmin
Cells(11, 2) = trueroot
Stop
ElseIf functionvaluemax = 0 Then
trueroot = xmax
Cells(11, 2) = trueroot
Stop
ElseIf functionvaluexnewbisect = 0 Then
trueroot = xnewbisect
Cells(11, 2) = trueroot
Stop
End If

Wend

End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
You are missing an End If.
If you indented your code it would be easier to find.
 
Upvote 0
The compiler recognizes that there is a branch error but can never say for sure which one it is, so it projects the error onto the first branch, which is the used While Wend construct.
What is actually missing is an End If at the end of your procedure, just before the Wend.
 
Upvote 0
Missing one "Endif" in your code.



VBA Code: 
Sub Button1_Click()
  'To ask user for highest exponent and dimension coefficient variables
  highestexponent = InputBox("Input largest exponent in f(x).")
  Dim coefficient(1000) As Double
  'To ask user for coefficient values
  For counter = 0 To highestexponent
  coefficient(counter) = InputBox("Input coefficients on the x^" & counter)
  Next counter
  'To define the function f(x)
  functionstring = "f(x)="
  For counter = highestexponent To 0 Step -1
  If counter > 0 Then
  functionstring = functionstring & coefficient(counter) & "xˆ " & counter & " + "
  Else
  functionstring = functionstring & coefficient(counter) & "xˆ " & counter
  End If
  Next counter
  activesheet.activesheet.Cells(2, 1) = functionstring
 
  Dim xmin As Integer
  Dim xmax As Integer
   
  xmin = InputBox("Input a lower bound x value to be evaluated in f(x) function.")
  xmax = InputBox("Input a higher bound x value to be evaluated in f(x) function.")
  'activesheet.cells(5,2) = xmin
  'activesheet.cells(4,2)=xmax
   
  Dim tolerance As Single
  tolerance = InputBox("Input a tolernace value for thr root.")
  'activesheet.cells(6,2)=root
  'activesheet.cells(7,2)=tolernace
  Dim functionvaluemin As Double
  Dim functionvaluemax As Double
  functionvaluemin = 0
  functionvaluemax = 0
  signdifference = 0
  While signdifference = 0
   
  For counter = 0 To highestexponent
  functionvaluemax = functionvaluemax + coefficient(counter) * xmax ^ (counter)
  Next counter
  For counter2 = 0 To highestexponent
  functionvaluemin = funcionvaluemin + coefficient(counter2) * xmin ^ (counter2)
  Next counter2
  'activesheet.cells(8,2)= functionvaluemax
  'activesheet.cells(9,2)= functionvaluemin
  If functionvaluemin > 0 And functionvaluemax > O Then
  MsgBox ("There is no sign difference between f(xmin) and f(xmax). Input new values.")
  xmin = InputBox("Input a lower bound x value to be evaluated in f(x) function.")
  xmax = InputBox("Input a higher bound x value to be evaluated in f(x) function.")
  ElseIf functionvaluemin < 0 And functionvaluemax < 0 Then
  MsgBox ("There is no sign difference between f(xmin) and f(xmax). Input new values.")
  xmin = InputBox("Input a lower bound x value to be evaluated in f(x) function.")
  xmax = InputBox("Input a higher bound x value to be evaluated in f(x) function.")
   
  Else
  signdifference = 1
  End If
  Wend
  Dim errormax As Double, trueroot As Double, xbisect As Double
  Dim functionvaluexnewbisect As Double
  xbisect = (xmin + xmax) / 2
  'activesheet.cells(6,2)=xbisect
   
  'Loop to solve for true root
  signdifference = 0
 
 
  While signdifference = 0
    errormax = (xmax - xmin) / 2
    'activesheet.cells(10,2)=errormax
    xnewbisect = (xmin + xmax) / 2
    'activesheet.cells(12,2)=xnewbisect
    'To evaluate f(xmin), f(xmax), and f(newbisect)
    functionvaluexnewbisect = 0
    functionvaluexmin = 0
    functionvaluemax = 0
    For counter4 = 0 To highestexponent
      functionvaluexnewbisect = functionvaluexnebisect + coefficient(counter4) * xnewbisect ^ (counter4)
    Next counter4
    For counter5 = 0 To highestexponent
      functionvaluexmax = functionvaluexmax + coefficient(counter5) * xmax ^ (counter5)
    Next counter5
     
    For counter6 = 0 To highestexponent
      functionvaluexmin = functionvaluexmin + coefficient(counter6) * xmin ^ (counter6)
    Next counter6
    'activesheet.cells(13,2)= functionvaluexnewbisect
    'activesheet.cells(14, 2) = functionvaluexmin
    'activesheet.cells(15,2)=functionvaluemax
     'To replace xmin/xmax with xnewbisect
    If errormax < tolerance Then
      trueroot = xnewbisect
      'activesheet.cells(11,2)=trueroot
      Stop
    ElseIf functionvaluexnewbisect > 0 And functionvaluexmin > 0 Then
      xmin = xnewbisect
    ElseIf functionvaluexnewbisect < 0 And functionvaluexmin < 0 Then
      xmin = xnewbisect
    ElseIf functionvaluaexnewbiseet > 0 And functionvaluexmax > 0 Then
      xmax = xnewbisect
    ElseIf functionvaluexnewbisect < 0 And functionvaluexmin < 0 Then
      xmax = xnewbisect
    ElseIf functionvaluexmin = 0 Then
      trueroot = xmin
      activesheet.Cells(11, 2) = trueroot
      Stop
    ElseIf functionvaluexmax = 0 Then
      trueroot = xmax
      activesheet.Cells(11, 2) = trueroot
      Stop
    ElseIf functionvaluexnewbisect = 0 Then
      trueroot = xnewbisect
      activesheet.Cells(11, 2) = trueroot
      Stop
      'activesheet.cells(13, 2)= functionvaluexnewbisect
      'Cells (14,2)=functionvaluexmin
      'Cells (15,2)=functionvaluexmax
      'To replace xmin/xmax with xnewbisect


    End If


    If errormax < tolerance Then
      trueroot = xnewbisect
      'Cells (11, 2) = trueroot
      Stop
    ElseIf functionvaluexnewbisect > 0 And functionvaluexmin > 0 Then
      xmin = xnewbisect
    ElseIf functionvaluexnewbisect < 0 And functionvaluexmin < 0 Then
      xmin = xnewbisect
    ElseIf functionvaluexnewbisect > 0 And functionvaluexmax > 0 Then
      xmax = xnewbisect
    ElseIf functionvaluexnewbisect < 0 And functionvaluexmax < 0 Then
      xmax = newbisect
    ElseIf functionvaluemin = 0 Then
      trueroot = xmin
      activesheet.Cells(11, 2) = trueroot
      Stop
    ElseIf functionvaluemax = 0 Then
      trueroot = xmax
      activesheet.Cells(11, 2) = trueroot
      Stop
    ElseIf functionvaluexnewbisect = 0 Then
      trueroot = xnewbisect
      activesheet.Cells(11, 2) = trueroot
      Stop
    End If
 
  Wend

End Sub
 
Upvote 0
Yashraj Jadhao said:
Where I am missing an End If?
Click to expand...
Probably after this
VBA Code: 
      ElseIf functionvaluexnewbisect = 0 Then
         trueroot = xnewbisect
         Cells(11, 2) = trueroot
         Stop
         'Cells(13, 2)= functionvaluexnewbisect
         'Cells (14,2)=functionvaluexmin
         'Cells (15,2)=functionvaluexmax
         'To replace xmin/xmax with xnewbisect
 
Upvote 0
You must log in or register to reply here.

Similar threads

ChrisGudrich
  • Solved
How to avoid or check in advance Runtime Error 5 using MID?
Replies
4
Views
558
ChrisGudrich
ChrisGudrich
mehidy1437
  • Question Question
Final code required expert opinion
Replies
8
Views
949
mehidy1437
mehidy1437
M
  • Question Question
Help correcting macro
2
Replies
15
Views
1K
shg
shg
J
  • Question Question
Run-time error '-2147417848 (80010108)': Automation error. The object invoked has disconnected from its clients.
Replies
1
Views
2K
Jefffey
J
M
  • Question Question
Adding an Appication.StatusBar = False to following macro
Replies
2
Views
357
michaelsmith559
M

Forum statistics

Threads
1,225,483
Messages
6,185,263
Members
453,284
Latest member
osy25

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