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