frmProgress.bas

Option Explicit

Private Sub ProgressBar_Run()
    
    Dim wsData As Worksheet, RowMax As Long, ColumnMax As Long
    Dim Counter As Long, RowNumber As Long, ColumnNumber As Long
    Dim PercentText As String
    
    Set wsData = ThisWorkbook.Worksheets("Data")
    With wsData
        
        .Cells.Clear
        
        Application.ScreenUpdating = False
        
        Counter = 1
        RowMax = 1000
        ColumnMax = 20
        
        For RowNumber = 1 To RowMax
            For ColumnNumber = 1 To ColumnMax
            
                .Cells(RowNumber, ColumnNumber).Value = Int(Rnd * 1000)
                Counter = Counter + 1
                
            Next ColumnNumber
            
            PercentText = Counter / (RowMax * ColumnMax)
            
            With frmProgress
                .FrameProgress.Caption = Format(PercentText, "0%")
                .LabelProgress.Width = PercentText * (.FrameProgress.Width - 10)
            End With
            
            DoEvents
            
        Next RowNumber
        
        Application.ScreenUpdating = True
    End With
    
    Set wsData = Nothing
    
    Unload frmProgress

End Sub

Private Sub UserForm_Activate()
    Call ProgressBar_Run
End Sub