grahampleigh
03-17-2020, 04:23 AM
I have searched this and several other forums but can't seem to find an answer for this problem, but I apologise in advance if this has already been posted.
I have an Add-in Called 'Personal Ribbon' which I use to perform a number of functions, but essentially it has some custom UI to create a new ribbon tab, and then from that tab I can perform various tasks, including inserting new sheets, showing custom userforms and performing various custom functions. The Personal Ribbon.xlam file has a number of sheets stored in it, but obviously these can't be accessed when the 'IsAddin' property is set to TRUE (default).
I have some custom code that requires the use of the goal seek function from a userform. Since the goal seek function has to 'exist' on a spreadsheet, rather than purely in the VBA space, I have used one of these add-in sheets to store the equations as part of the calculation process.
The following code works perfrectly well if the sheet is visible, i.e., if the IsAddin property is set to FALSE. But when set to true (which is the way it normally is) the values from the userform are not passed to the sheet and so the code doesn't work, and I can't figure out why.
Supporting Info:
Worksheets("Pipe Dimensions") - this is the name of the sheet that is embedded in the .xlam (ie it is normally not visible). it contains various tables of data, and also the named ranges shown below which are used as part of the goal seek function.
The Sub Calc_FrictionFactor() is the code that is called from the custom UserForm when either of the input textboxes values changes.
The 'target' of the Goal Seek is f_Obj, which is set to 0 (rounded to 5 decimal places). In reality on the worksheet, this cell is the left hand side of the equation minus the right hand side of the equation.
Private Sub Calc_FrictionFactor()
On Error GoTo Err
Dim f_e, f_Re, f_f, f_Obj As Range
If txtRelRoughness.Text = "" Or txtReynolds.Text = "" Then Exit Sub 'input textboxes from Flow Calc userform
Set f_e = ThisWorkbook.Worksheets("Pipe Dimensions").Range("f_e") 'relative roughness
Set f_Re = ThisWorkbook.Worksheets("Pipe Dimensions").Range("f_Re") 'Reynolds Number
Set f_f = ThisWorkbook.Worksheets("Pipe Dimensions").Range("f_f") 'Friction Factor (value to be found)
Set f_Obj = ThisWorkbook.Worksheets("Pipe Dimensions").Range("f_Obj") 'target for goal seek (set to 0)
Application.ScreenUpdating = False
f_e.Value = Val(txtRelRoughness.Text) 'set the value in the worksheet to the value from the userform
f_Re.Value = Val(txtReynolds.Text) 'set the value in the worksheet to the value from the userform
Static isWorking As Boolean
f_f.Value = 0.01 'initial (positive) guess for Friction Factor
If Round(Range("f_Obj").Value, 5) <> 0 And Not isWorking Then
isWorking = True
Range("f_Obj").GoalSeek Goal:=0, changingcell:=Range("f_f")
isWorking = False
End If
txtFriction.Text = Round(f_f.Value, 5) 'show the result of the equation in the userform
Set f_e = Nothing
Set f_Re = Nothing
Set f_f = Nothing
Set f_Obj = Nothing
Application.ScreenUpdating = True
Exit Sub
Err:
End Sub
I have various other functions and userforms that use this code perfectly well (eg populating listboxes/comboboxes with ranges).
Set <range> = ThisWorkbook.Worksheets("<Sheet Name>").Range("<Sheet Named Range>") so I am fairly sure this isn't the issue.
If I set my On error Goto '0' instead of just 'Err' I get the following error code:
Run-time error '1004': Method 'Range' Object '_Global' failed. on this line:
If Round(Range("f_Obj").Value, 5) <> 0 And Not isWorking Then
Can anyone help me with what I'm doing wrong here? I'm sure it's something simple but I've been going round in circles with this for a while now and can't resolve it.:banghead:
As a side note, this problem only exists because I need to send data to/from a worksheet, if there was a way to run Goal Seek exclusively within VBA then this would be better. But I don't believe this is possible?
Alternatively, I suppose I could try and code an iterative loop using VBA to mimic what Goal Seek is doing, but not sure how to approach that at the moment.
I have an Add-in Called 'Personal Ribbon' which I use to perform a number of functions, but essentially it has some custom UI to create a new ribbon tab, and then from that tab I can perform various tasks, including inserting new sheets, showing custom userforms and performing various custom functions. The Personal Ribbon.xlam file has a number of sheets stored in it, but obviously these can't be accessed when the 'IsAddin' property is set to TRUE (default).
I have some custom code that requires the use of the goal seek function from a userform. Since the goal seek function has to 'exist' on a spreadsheet, rather than purely in the VBA space, I have used one of these add-in sheets to store the equations as part of the calculation process.
The following code works perfrectly well if the sheet is visible, i.e., if the IsAddin property is set to FALSE. But when set to true (which is the way it normally is) the values from the userform are not passed to the sheet and so the code doesn't work, and I can't figure out why.
Supporting Info:
Worksheets("Pipe Dimensions") - this is the name of the sheet that is embedded in the .xlam (ie it is normally not visible). it contains various tables of data, and also the named ranges shown below which are used as part of the goal seek function.
The Sub Calc_FrictionFactor() is the code that is called from the custom UserForm when either of the input textboxes values changes.
The 'target' of the Goal Seek is f_Obj, which is set to 0 (rounded to 5 decimal places). In reality on the worksheet, this cell is the left hand side of the equation minus the right hand side of the equation.
Private Sub Calc_FrictionFactor()
On Error GoTo Err
Dim f_e, f_Re, f_f, f_Obj As Range
If txtRelRoughness.Text = "" Or txtReynolds.Text = "" Then Exit Sub 'input textboxes from Flow Calc userform
Set f_e = ThisWorkbook.Worksheets("Pipe Dimensions").Range("f_e") 'relative roughness
Set f_Re = ThisWorkbook.Worksheets("Pipe Dimensions").Range("f_Re") 'Reynolds Number
Set f_f = ThisWorkbook.Worksheets("Pipe Dimensions").Range("f_f") 'Friction Factor (value to be found)
Set f_Obj = ThisWorkbook.Worksheets("Pipe Dimensions").Range("f_Obj") 'target for goal seek (set to 0)
Application.ScreenUpdating = False
f_e.Value = Val(txtRelRoughness.Text) 'set the value in the worksheet to the value from the userform
f_Re.Value = Val(txtReynolds.Text) 'set the value in the worksheet to the value from the userform
Static isWorking As Boolean
f_f.Value = 0.01 'initial (positive) guess for Friction Factor
If Round(Range("f_Obj").Value, 5) <> 0 And Not isWorking Then
isWorking = True
Range("f_Obj").GoalSeek Goal:=0, changingcell:=Range("f_f")
isWorking = False
End If
txtFriction.Text = Round(f_f.Value, 5) 'show the result of the equation in the userform
Set f_e = Nothing
Set f_Re = Nothing
Set f_f = Nothing
Set f_Obj = Nothing
Application.ScreenUpdating = True
Exit Sub
Err:
End Sub
I have various other functions and userforms that use this code perfectly well (eg populating listboxes/comboboxes with ranges).
Set <range> = ThisWorkbook.Worksheets("<Sheet Name>").Range("<Sheet Named Range>") so I am fairly sure this isn't the issue.
If I set my On error Goto '0' instead of just 'Err' I get the following error code:
Run-time error '1004': Method 'Range' Object '_Global' failed. on this line:
If Round(Range("f_Obj").Value, 5) <> 0 And Not isWorking Then
Can anyone help me with what I'm doing wrong here? I'm sure it's something simple but I've been going round in circles with this for a while now and can't resolve it.:banghead:
As a side note, this problem only exists because I need to send data to/from a worksheet, if there was a way to run Goal Seek exclusively within VBA then this would be better. But I don't believe this is possible?
Alternatively, I suppose I could try and code an iterative loop using VBA to mimic what Goal Seek is doing, but not sure how to approach that at the moment.