how to set up progress display for code that takes a long time

I have a couple codes that delete a lot of data from my workbook but it takes almost 10 sec to complete. I'd like to put a progress tracker display of some sort that will let the user know its still working so they dont start clicking stuff or close it down thinking the program crashed. The code being used to delete data is this.

Private Sub clearall_Click()
    'clears all data
   ' Application.ScreenUpdating = False
    With Sheet8
        .Range("a2:t71821").ClearContents
        .Range("w2:ad38959").ClearContents
        .Range("ag2:an38959").ClearContents
        .Range("aq2:ax38959").ClearContents
        .Range("ba2:bh38959").ClearContents
        .Range("Bl2:ca1899").ClearContents
    End With
    Sheet7.Cells.ClearContents
    Sheet14.Range("c5:e131").ClearContents

I already have a progress bar for a different part of the program but it tracks progress by which array the code is using. In this code im not sure how to track which range its working on.

I'm not sure if the other progress bar can be converted to be used here but its code is

 UserForm1.Show ' show progress form
    Dim pctCompl As Integer
    pctCompl = 0
    UserForm1.Text.Caption = pctCompl & "% Completed"
    UserForm1.Bar.Width = pctCompl * 2
    UserForm1.Repaint
    
    Application.ScreenUpdating = False
    Dim e
    For Each e In Array(Array("Connectivity suite", Range("c5")), Array("Connectivity suite", Range("y5")), Array("Connectivity suite", Range("au5")), Array("Connectivity suite", Range("bq5"))) 'position of large list scores and labels on symptoms & locations worksheet
           
        Application.ScreenUpdating = True
        UserForm1.LabelTitle = "Processing " & CStr(e(0))
        pctCompl = pctCompl + 25
        UserForm1.Text.Caption = pctCompl & "% Completed"
        UserForm1.Bar.Width = pctCompl * 2
        UserForm1.Repaint
        Application.ScreenUpdating = False

That clearall code should not be taking 10sec to run.
Do you have any event code on those sheets, or formulae looking at the ranges being cleared?

yes sheet8 has all the data that 20 other sheets look to for data anlaysis so there is a lot of computing going on when they change. I dont know if that can be changed.

In that case try adding the 2 lines in red

Private Sub clearall_Click()
    'clears all data
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Sheet8
        .Range("a2:t71821").ClearContents
        .Range("w2:ad38959").ClearContents
        .Range("ag2:an38959").ClearContents
        .Range("aq2:ax38959").ClearContents
        .Range("ba2:bh38959").ClearContents
        .Range("Bl2:ca1899").ClearContents
    End With
    Sheet7.Cells.ClearContents
    Sheet14.Range("c5:e131").ClearContents
    Application.Calculation = xlCalculationAutomatic
End Sub

Does it help if you ad these other 2 lines

Private Sub clearall_Click()
    'clears all data
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Application.EnableEvents = False
    With Sheet8
        .Range("a2:t71821").ClearContents
        .Range("w2:ad38959").ClearContents
        .Range("ag2:an38959").ClearContents
        .Range("aq2:ax38959").ClearContents
        .Range("ba2:bh38959").ClearContents
        .Range("Bl2:ca1899").ClearContents
    End With
    Sheet7.Cells.ClearContents
    Sheet14.Range("c5:e131").ClearContents
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

not noticing a huge improvement. It seems the screen is showing its done a little sooner but if i try to run something else it shows its still calculating stuff. I'm not sure if looking into speeding up the process is better than putting a progress bar. Although I love learning how to speed it up

I've never used progress bars, so unfortunately cannot help any further.

not a problem I appreciate the advise on how to speed up the process.

Found a way that works.. its ugly but it works. If anyone has a better way I'd love to see it.

Private Sub clearall_Click()

UserForm1.Show ' show progress form
    Dim pctCompl As Integer
    pctCompl = 0
    UserForm1.Text.Caption = pctCompl & "% Completed"
    UserForm1.Bar.Width = pctCompl * 2
    UserForm1.Repaint
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    
    
    
        Application.ScreenUpdating = True
        UserForm1.LabelTitle = "Clearing FFT"
        pctCompl = pctCompl + 0
        UserForm1.Text.Caption = pctCompl & "% Completed"
        UserForm1.Bar.Width = pctCompl * 2
        UserForm1.Repaint
        
    
       
     Sheet8.Range("a2:t71821").ClearContents
     
  
       
        UserForm1.LabelTitle = "Clearing Coherence"
        pctCompl = pctCompl + 16.3
        UserForm1.Text.Caption = pctCompl & "% Completed"
        UserForm1.Bar.Width = pctCompl * 2
        UserForm1.Repaint
        
    Sheet8.Range("w2:ad38959").ClearContents
    
 
        
        UserForm1.LabelTitle = "Clearing Phase"
        pctCompl = pctCompl + 16.3
        UserForm1.Text.Caption = pctCompl & "% Completed"
        UserForm1.Bar.Width = pctCompl * 2
        UserForm1.Repaint
        
     Sheet8.Range("ag2:an38959").ClearContents
     
    
       
        UserForm1.LabelTitle = "Clearing Phase Lock"
        pctCompl = pctCompl + 16.3
        UserForm1.Text.Caption = pctCompl & "% Completed"
        UserForm1.Bar.Width = pctCompl * 2
        UserForm1.Repaint
        
     Sheet8.Range("aq2:ax38959").ClearContents
     
     
        
        UserForm1.LabelTitle = "Clearing Phase Shift"
        pctCompl = pctCompl + 16.3
        UserForm1.Text.Caption = pctCompl & "% Completed"
        UserForm1.Bar.Width = pctCompl * 2
        UserForm1.Repaint
       
      Sheet8.Range("ba2:bh38959").ClearContents
      
    
        
        UserForm1.LabelTitle = "Clearing Absolute Power"
        pctCompl = pctCompl + 16.3
        UserForm1.Text.Caption = pctCompl & "% Completed"
        UserForm1.Bar.Width = pctCompl * 2
        UserForm1.Repaint
       
    Sheet8.Range("Bl2:ca1899").ClearContents
   
    
    Sheet7.Cells.ClearContents
    Sheet14.Range("c5:e131").ClearContents
    Application.ScreenUpdating = False
    'Application.Calculation = xlCalculationAutomatic
    Unload UserForm1