Run the code faster.

[countryfan_nt]

Hello friends, hope all is well!
can you please help me make the below code run faster?

Thank you very much in advance!

Sub DoWhileDemo()

Sheets("bmi").Range("B34").ClearContents

Range("A1").Select

Do Until Sheets("bmi").Range("C34").Value = True
Sheets("BMI").Range("B34").Value = Sheets("BMI").Range("B34").Value + 1 'Sheets("BMI").Range("F34").Value
  DoEvents 'Wait for things to update
  Application.Wait (Now() + CDate("00:00:01")) / 5000
  Loop
  
Application.ScreenUpdating = False
    Range("E34").Select
    Selection.Copy
    Range("B34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Application.ScreenUpdating = True
End Sub

[kev_]

Hi countryfan_nt

What are you trying to achieve here?

When do you expect this loop to terminate?:

Do Until Sheets("bmi").Range("C34").Value = True

[countryfan_nt]

B34 = the code above runs in cell B34, hence, values start from 0 and stops when C34 becomes TRUE.
C34 formula: =IF(E34<=B34,TRUE,B34).
E34 has the target value, to finally show the desired result.

[kev_]

Remove this line:

Application.Wait (Now() + CDate("00:00:01")) / 5000

and move this line:

Application.ScreenUpdating = False

above this line:

Do Until Sheets("bmi").Range("C34").Value = True

[countryfan_nt]

done, but still not fast enough. you see this is feeds a chart, and I wish to see the chart results run faster.

[kev_]

To speed up processing
- use a variable to calculate
- write the result to the cell when condition satisfied

Try this:

Sub DoWhileDemo()
    Dim B34 As Double
    Application.ScreenUpdating = False

    With Sheets("BMI")
       .Range("B34").ClearContents
       .Range("A1").Select
        B34 = .Range("B34").Value
      
        Do Until .Range("E34").Value <= B34
            B34 = B34 + 0.1
        Loop
       .Range("B34").Value = B34
    
      
       .Range("B34").Value = .Range("E34").Value
       .Range("E34").Copy
       .Range("B34").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    Application.ScreenUpdating = True
End Sub

EDIT - please note that I amended the code in a couple of places after posting

[countryfan_nt]

Thank you very much!

[kev_]

You are welcome. Thanks for reps and marking thread SOLVED