Progress bar...%

[Leith Ross]

Hello Shamim,

Here is the code to update the progress bar (UserForm1). The attached workbook has the code shown added to it.

Option Explicit


Public Completed    As Long
Public EndCount     As Long
 
Sub Split_Data_in_workbooks()


Application.ScreenUpdating = False




Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("Data")


Dim setting_Sh As Worksheet
Set setting_Sh = ThisWorkbook.Sheets("Settings")


Dim nwb As Workbook
Dim nsh As Worksheet


Dim wkbPath As String


''''' Get unique supervisors


setting_Sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("B:B").Copy setting_Sh.Range("A1")


setting_Sh.Range("A:A").RemoveDuplicates 1, xlYes


Dim i As Integer


Completed = 0


UserForm1.Show False


EndCount = Application.CountA(setting_Sh.Range("A:A"))


wkbPath = setting_Sh.Range("H6")
If wkbPath = "" Then wkbPath = ThisWorkbook.Path


For i = 2 To EndCount
    
    DoEvents
    
    Completed = Completed + 1
    With UserForm1
        .Label2.Width = .Label1.Width * (Completed / (EndCount - 1))
        .Label3.Caption = "Percent complete " & Format(Completed / (EndCount - 1), "0%")
    End With
    
    data_sh.UsedRange.AutoFilter 2, setting_Sh.Range("A" & i).Value
    
    Set nwb = Workbooks.Add
    Set nsh = nwb.Sheets(1)
    
    data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
    nsh.UsedRange.EntireColumn.ColumnWidth = 15
    
    nwb.SaveAs wkbPath & "/" & setting_Sh.Range("A" & i).Value & ".xlsx"
    nwb.Close False
    data_sh.AutoFilterMode = False
Next i


setting_Sh.Range("A:A").Clear


End Sub