the fastest way to find first y equals zero in wave like function using VBA iteration

witamserdecznie

New Member
Joined
Jun 12, 2010
Messages
34
Hi,

I have an excel spreadsheet that does a lot of calculations to find delta (y on the attached diagram) for given member length in mm (x on the attached diagram). The whole point is to find the first member length for which delta = 0. Problem is that there is no equation of the function and it is wave like or more like Bessel function. See below png file which shows typical functions that I get from the calculations.
https://www.dropbox.com/s/q99ki24u8yyphkw/function diagram.png?dl=0

I wrote a VBA that iterates member length until it finds delta = 0. But this is a slow process and when I tried to speed it up it sometimes jumps over the first solution, this is especially the case when solution is relatively close to the beginning of the iteration process.

The member length typically starts around a few meters and delta can be positive or negative, can go away or towards zero depending on other input in the spreadsheet but this is unpredictable so cannot program VBA for that.

I also attach two videos showing the iteration process, one finds the solution while the other jumps over it. When I reduce the iteration step too soon to 1mm then it dramatically increases calculation time.
https://www.dropbox.com/s/l68qpykjaufa2nc/solves.avi?dl=0
https://www.dropbox.com/s/4mt4xsntuas1rcr/does not solve.avi?dl=0

Would you have any idea how to speed up, and make more accurate (not to jump over the solution) the below code? There are three sections of the code but these are very much the same, these just restart the iteration when delta is moving away from zero.

Thanks in advance!

I21 - is the starting member length
F12 - is the member length used to calculate delta
L117 - is the delta = FLOOR(ABS(delta),0.005)
J18 to J25 - are the various length increments: member length + 250, 100, 50, 25, 10, 5, 2, 1 respectively.
Progress - just updates the userform

Code:
Private Sub UserForm_Activate()
    Dim a As Single, b As Single
    Application.ScreenUpdating = False
    Range("F12").Value = 0
    Range("F12").Value = Range("I21").Value

        Do Until Range("L117") < 2
            Range("F12").Value = Range("J18").Value
            Call Progress
            If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        Loop
        Do Until Range("L117") < 1
            If Range("L117").Value = 0 Then GoTo End_it
            a = Range("L117").Value
            Range("F12").Value = Range("J19").Value
            Call Progress
            If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
            b = Range("L117").Value
            If b > a Then GoTo Second_Take
        Loop
        Do Until Range("L117") < 0.5
            If Range("L117").Value = 0 Then GoTo End_it
            a = Range("L117").Value
            Range("F12").Value = Range("J20").Value
            Call Progress
            If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
            b = Range("L117").Value
            If b > a Then GoTo Second_Take
        Loop
        Do Until Range("L117") < 0.15
            If Range("L117").Value = 0 Then GoTo End_it
            a = Range("L117").Value
            Range("F12").Value = Range("J21").Value
            Call Progress
            If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
            b = Range("L117").Value
            If b > a Then GoTo Second_Take
        Loop
        Do Until Range("L117") < 0.05
            If Range("L117").Value = 0 Then GoTo End_it
            a = Range("L117").Value
            Range("F12").Value = Range("J22").Value
            Call Progress
            If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
            b = Range("L117").Value
            If b > a Then GoTo Second_Take
        Loop
        Do Until Range("L117") < 0.02
            If Range("L117").Value = 0 Then GoTo End_it
            a = Range("L117").Value
            Range("F12").Value = Range("J23").Value
            Call Progress
            If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
            b = Range("L117").Value
            If b > a Then GoTo Second_Take
        Loop
        Do Until Range("L117") < 0.01
            If Range("L117").Value = 0 Then GoTo End_it
            a = Range("L117").Value
            Range("F12").Value = Range("J24").Value
            Call Progress
            If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
            b = Range("L117").Value
            If b > a Then GoTo Second_Take
        Loop
        Do Until Range("L117") < 0.001
            If Range("L117").Value = 0 Then GoTo End_it
            a = Range("L117").Value
            Range("F12").Value = Range("J25").Value
            Call Progress
            If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
            b = Range("L117").Value
            If b > a Then GoTo Second_Take
        Loop

Second_Take:
    Do
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J18").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
    Loop Until a > b
    Do Until Range("L117") < 2
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J18").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    Do Until Range("L117") < 1
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J19").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
        If b > a Then GoTo Third_Take
    Loop
    Do Until Range("L117") < 0.5
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J20").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
        If b > a Then GoTo Third_Take
    Loop
    Do Until Range("L117") < 0.15
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J21").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
        If b > a Then GoTo Third_Take
    Loop
    Do Until Range("L117") < 0.05
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J22").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
        If b > a Then GoTo Third_Take
    Loop
    Do Until Range("L117") < 0.02
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J23").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
        If b > a Then GoTo Third_Take
    Loop
    Do Until Range("L117") < 0.01
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J24").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
        If b > a Then GoTo Third_Take
    Loop
    Do Until Range("L117") < 0.001
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J25").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
        If b > a Then GoTo Third_Take
    Loop

Third_Take:
    Do
        If Range("L117").Value = 0 Then GoTo End_it
        a = Range("L117").Value
        Range("F12").Value = Range("J18").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
        b = Range("L117").Value
    Loop Until a > b
    Do Until Range("L117") < 2
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J18").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    Do Until Range("L117") < 1
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J19").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    Do Until Range("L117") < 0.5
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J20").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    Do Until Range("L117") < 0.15
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J21").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    Do Until Range("L117") < 0.05
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J22").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    Do Until Range("L117") < 0.02
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J23").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    Do Until Range("L117") < 0.01
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J24").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    Do Until Range("L117") < 0.001
        If Range("L117").Value = 0 Then GoTo End_it
        Range("F12").Value = Range("J25").Value
        Call Progress
        If Range("F12").Value > Range("F13").Value * 2 Then GoTo End_it
    Loop
    GoTo End_it

End_it:
    Application.ScreenUpdating = True
    Exit Sub
End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Watch MrExcel Video

Forum statistics

Threads
1,130,046
Messages
5,639,753
Members
417,108
Latest member
Thein Than

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
Top