Changing a code to make it dyamic

[annmarie]

Hi,
I have a code which converges in a loop. It is referenced to 4 cells in a row. I want to change it so its dyamic and each time the macro runs to calculate all the active rows in my spread sheet. This is my code have have so far (looks long and complicated I know)

Sub Worksheet_Calculate()
Dim dblD As Double
Dim dblX As Double
Dim dblHL As Double
Dim dblHLOverD As Double
Dim dblTheta As Double
Dim dblCosTheta As Double
Dim dblF2 As Double
Dim dblHHL As Double
Dim myCell As Range
Static bWorking As Boolean
Const PI = 3.141592654
If bWorking = False Then

bWorking = True

'Get the value for fraction occupancy
Set myCell = Range("X11")
dblX = CDbl(myCell.Value)

'Get the value for diameter
Set myCell = Range("AB11")
dblD = myCell.Value

'Get the value for heavy liquid depth
Set myCell = Range("AL11")
dblHHL = myCell.Value



dblHL = dblD / 2


Do
dblCosTheta = (1 - 2 * dblHL / dblD)
dblTheta = ACOS(1 - 2 * dblHL / dblD)
dblF2 = (dblTheta / PI) - (Sin(dblTheta) * Cos(dblTheta) / PI)
dblHLOverD = dblHL / dblD


'Check for convergence
If Abs(dblX - dblF2) < 0.00001 Then
Exit Do
End If

'Adjust HL
dblHL = dblHL * dblX / dblF2


DoEvents
Loop


Set myCell = Range("AM11")
Debug.Print dblHL - dblHHL


'Write result
myCell.Value = dblHL - dblHHL


bWorking = False
End If

End Sub


The 4 cells that are reference I want to change-I have managed this with goal seek where it was referenced to 3 cells in row 11 but found a way to make it work for the whole sheet-eg

Sub AutoGoalSeek()
Dim x As Long
Dim LastRow As Long
Const StartRow As Long = 1
With ActiveSheet
LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
For x = StartRow To LastRow
If .Range("AK" & x).HasFormula Then
.Range("AK" & x).GoalSeek Goal:=.Range("AI" & x), _
ChangingCell:=.Range("AJ" & x)
End If
Next x
End With

End Sub

I have tryed changing the range in the top code to be Set myRange = Range("X" & x)
but this gives me the error "Method 'Range' of object'_Gobal' failed.

Please can anyone help me change the top code to work dyamically like the 2nd code.

Thank you in Advanced.

Ann-Marie

 

[annmarie]

Hi anyone out there willing to take a look at me code please and point me in the right direction?

 

[drsarao]

Welcome to Board
Set myRange = Cells(x, "X") will work.

Try (untested):

Sub Worksheet_Calculate()
Dim dblD As Double
Dim dblX As Double
Dim dblHL As Double
Dim dblHLOverD As Double
Dim dblTheta As Double
Dim dblCosTheta As Double
Dim dblF2 As Double
Dim dblHHL As Double
Dim myCell As Range
Static bWorking As Boolean
Const PI = 3.141592654
Dim x As Long
Dim LastRow As Long
Const StartRow As Long = 1
With ActiveSheet
LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
For x = StartRow To LastRow
    If bWorking = False Then bWorking = True
    'Get the value for fraction occupancy
    Set myCell = Cells(x, "X")
    dblX = CDbl(myCell.Value)
    'Get the value for diameter
    Set myCell = Cells(x, "AB")
    dblD = myCell.Value
    'Get the value for heavy liquid depth
    Set myCell = Cells(x, "AL")
    dblHHL = myCell.Value
    dblHL = dblD / 2
    Do
        dblCosTheta = (1 - 2 * dblHL / dblD)
        dblTheta = Acos(1 - 2 * dblHL / dblD)
        dblF2 = (dblTheta / PI) - (Sin(dblTheta) * Cos(dblTheta) / PI)
        dblHLOverD = dblHL / dblD
        'Check for convergence
        If Abs(dblX - dblF2) < 0.00001 Then Exit Do
        'Adjust HL
        dblHL = dblHL * dblX / dblF2
        DoEvents
    Loop
    Set myCell = Cells(x, "AM")
    Debug.Print dblHL - dblHHL
    'Write result
    myCell.Value = dblHL - dblHHL
Next
bWorking = False
End Sub

I have removed a marooned "EndIf" at the end.
The code looks very "busy". May not be a good idea to put it in Worksheet_Calculate()

 

[annmarie]

Hi,

Thank you for helping I've change the code but it still gets stuck at dblD = myCell.Value.
I get the error "Type Mismatch"
Sorry I'm really new to VB code-trying my hardest but not quite all there yet.

 

[drsarao]

Hi,

Thank you for helping I've change the code but it still gets stuck at dblD = myCell.Value.
I get the error "Type Mismatch"
Sorry I'm really new to VB code-trying my hardest but not quite all there yet.

I don't know what is the data type in AB11. But seeing it used in X11, I suppose CDbl() is needed here also. And in AM11.
dblX = CDbl(myCell.Value)
dblHHL = CDbl(myCell.Value)

 

[northwolves]

Hi,

Thank you for helping I've change the code but it still gets stuck at dblD = myCell.Value.
I get the error "Type Mismatch"
Sorry I'm really new to VB code-trying my hardest but not quite all there yet.

Try:

dblD = Cdbl(myCell.Value)