Progress bar...%

[shamim]

Hi,I want to add a progress bar which already designed in attached excel workbook with the name of Userform1. The progress bar should show the % of macro progress.Regards,Uday

[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

[shamim]

Thanks!! :yes

[Leith Ross]

Hello Shamim,

You're welcome.