Progress Bar

S

shaunkaz

Board Regular
Joined
Jan 30, 2008
Messages
204
Hi I have a macro which updates our core stock sheet, however is it possible when this is running it displays a progress bar to display its progress..

Below is my code

Thanks





Sub Update_Core_Stock()
'
' Update_Core_Stock Macro
' This will update the core stock. SBanks
'
' Message to confirm execution of program
var1 = MsgBox("YOU ARE ABOUT TO UPDATE THIS FILE.. ARE YOU SURE YOU WANT TO UPDATE?? IF YOU DO PLEASE CLICK YES OTHERWISE TO EXIT PLEASE PRESS NO ", vbYesNo + vbCritical, "Schneider-Electric Manufacturing Order Book")
If var1 = vbNo Then
stopnow = True

Else

End If

' Import FH30 Sheet Clear
Sheets("Import FH30").Select
Range("A2:Q2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select


' FH30 Open Orders Sheet Clear
Sheets("FH 30 O.Orders").Select
Range("A2:S2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select


' FH30 Open Delivery Sheet Clear
Sheets("FH 30 O.Delivery").Select
Range("A2:P2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select


' Import COOIS Sheet Clear
Sheets("Import COOIS").Select
Range("A2:T2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select


' OPEN Downloads from Supplu chain File
Sheets("Import FH30").Select
ChDir "J:\Supply Chain\Order Books\Manufacturing Order Book Downloads"
Workbooks.Open Filename:= _
"J:\Supply Chain\Order Books\Manufacturing Order Book Downloads\COIS Download.xls"
Workbooks.Open Filename:= _
"J:\Supply Chain\Order Books\Manufacturing Order Book Downloads\Import FH09.xls"
Workbooks.Open Filename:= _
"J:\Supply Chain\Order Books\Manufacturing Order Book Downloads\Open Deliveries Report.xls"
Workbooks.Open Filename:= _
"J:\Supply Chain\Order Books\Manufacturing Order Book Downloads\Open Order Report.xls"



' Copy SAP Download from IMPORT FH09
Windows("Import FH09.xls").Activate
Sheets("Sheet1").Select
Range("A2:Q2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy


' Paste Import FH09 download into Core Stock
Windows("Copy of Manufacturing daily order book 2012 UK V2.xlsm").Activate
Sheets("Import FH30").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D2").Select
Sheets("FH 30 O.Orders").Select


' Copy SAP Download from Open Order Report

Windows("Open Order Report.xls").Activate
Sheets("Sheet1").Select
Range("A2:S2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy


' Paste Import Open Orders download into Core Stock

Windows("Copy of Manufacturing daily order book 2012 UK V2.xlsm").Activate
Sheets("FH 30 O.Orders").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G2").Select
Sheets("FH 30 O.Delivery").Select


' Copy SAP Download from Open Delivery Report

Windows("Open Deliveries Report.xls").Activate
Sheets("Sheet1").Select
Range("A2:P2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy


' Paste Import Open Delivery download into Core Stock

Windows("Copy of Manufacturing daily order book 2012 UK V2.xlsm").Activate
Sheets("FH 30 O.Delivery").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Import COOIS").Select


' Copy SAP Download from COOIS Report

Windows("COIS Download.xls").Activate
Sheets("Sheet1").Select
Range("A2:R2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

' Paste Import COOIS download into Core Stock

Windows("Copy of Manufacturing daily order book 2012 UK V2.xlsm").Activate
Sheets("IMPORT COOIS").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Close Download Reports

Windows("Open Order Report.xls").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Windows("Open Deliveries Report.xls").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Windows("COIS Download.xls").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
Windows("Import FH09.xls").Activate
Application.DisplayAlerts = False
ActiveWindow.Close


' UPDATE CORE STOCK VIA SAP TAB

Sheets("SAP").Select
Range("AI3:AK3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Range("A3").Select
Do While ActiveCell.Formula <> ""
ActiveCell.Offset(0, 1).Select
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


' Select Current Tab As Finished

Sheets("CURRENT").Select
Application.CutCopyMode = False
ActiveWorkbook.Save


' Message upon Completion
var1 = MsgBox("Imports Completed and Document Saved", vbOKOnly + vbInformation, "Thankyou")


End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
shaunkaz,

Before implementing a progress bar, you might consider optimizing your code. For example, I notice numerous uses of .Select and .Activate - most of which are unnecessary and contribute to poor performance. And turning off ScreenUpdating can greatly improve performance.

Cheers,

tonyyy
 
Upvote 0
Hi Shaun,

I have modified your code so that overall performance of the macro can be improved. And, I have added code for status bar which tells you status how much task are completed by the macro in percentage. You want to see the progress of the macro so you can use status bar instead of progress bar as progress bar will impact overall performance of the macro.

PFB for the code. I hope this code will help.
Code: 
Sub CoreStockWithStatusBar()


'
'
'Code by Ramandeep Singh
'
'


Dim Var1 As Byte
Dim FolderPath As String
Dim LastRow As Long
Dim CompletedPercentage As Integer




CompletedPercentage = 0
FolderPath = "J:\Supply Chain\Order Books\Manufacturing Order Book Downloads"


'Disabling screen updates
Application.ScreenUpdating = False


'Code for Status bar
Application.StatusBar = CompletedPercentage & " % completed..."


'Message to confirm execution of program
Var1 = MsgBox("YOU ARE ABOUT TO UPDATE THIS FILE.. ARE YOU SURE YOU WANT TO UPDATE?? IF YOU DO PLEASE CLICK YES OTHERWISE TO EXIT PLEASE PRESS NO ", vbYesNo + vbCritical, "Schneider-Electric Manufacturing Order Book")


If Var1 = vbNo Then


'stopnow = True
    
'Below code used for stopping execution of the code
Exit Sub


End If


'Step 1
' Import FH30 Sheet Clear
Sheets("Import FH30").Select
Range(Range("A2:Q2"), Range("A2:Q2").End(xlDown)).ClearContents
Range("A2").Select


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 2
' FH30 Open Orders Sheet Clear
Sheets("FH 30 O.Orders").Select
Range(Range("A2:S2"), Range("A2:S2").End(xlDown)).ClearContents
Range("A2").Select


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 3
' FH30 Open Delivery Sheet Clear
Sheets("FH 30 O.Delivery").Select
Range(Range("A2:P2"), Range("A2:P2").End(xlDown)).ClearContents
Range("A2").Select


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 4
' Import COOIS Sheet Clear
Sheets("Import COOIS").Select
Range(Range("A2:T2"), Range("A2:T2").End(xlDown)).ClearContents
Range("A2").Select


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 5
'Opening the workbook
Workbooks.Open Filename:=FolderPath & "COIS Download.xls"


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 6
'Copy SAP Download from COOIS Report
Sheets("Sheet1").Select
Range("A2:R2").Select
Range(Selection, Selection.End(xlDown)).Copy


'Paste Import COOIS download into Core Stock
Windows("Copy of Manufacturing daily order book 2012 UK V2.xlsm").Activate
Sheets("IMPORT COOIS").Select
Range("A2").PasteSpecial Paste:=xlPasteValues


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 7
'Closing the workbook
Workbooks("COIS Download.xls").Close False


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 8
'Opening the workbook
Workbooks.Open Filename:=FolderPath & "Import FH09.xls"


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 9
'Copy SAP Download from IMPORT FH09
Sheets("Sheet1").Select
Range("A2:Q2").Select
Range(Selection, Selection.End(xlDown)).Copy




'Paste Import FH09 download into Core Stock
Windows("Copy of Manufacturing daily order book 2012 UK V2.xlsm").Activate
Sheets("Import FH30").Select
Range("A2").PasteSpecial Paste:=xlPasteValues
Range("D2").Select


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 10
'Closing the workbook
Workbooks("Import FH09.xls").Close False


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 11
'Opening the workbook
Workbooks.Open Filename:=FolderPath & "Open Deliveries Report.xls"


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 12
'Copy SAP Download from Open Delivery Report
Sheets("Sheet1").Select
Range("A2:P2").Select
Range(Selection, Selection.End(xlDown)).Copy


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


Step 13
'Paste Import Open Delivery download into Core Stock
Windows("Copy of Manufacturing daily order book 2012 UK V2.xlsm").Activate
Sheets("FH 30 O.Delivery").Select
Range("A2").PasteSpecial Paste:=xlPasteValues


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 14
'Closing the workbook
Workbooks("Open Deliveries Report.xls").Close False


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 15
'Opening the workbook
Workbooks.Open Filename:=FolderPath & "Open Order Report.xls"


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 16
'Copy SAP Download from Open Order Report
Sheets("Sheet1").Select
Range("A2:S2").Select
Range(Selection, Selection.End(xlDown)).Copy


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


Step 17
'Paste Import Open Orders download into Core Stock
Windows("Copy of Manufacturing daily order book 2012 UK V2.xlsm").Activate
Sheets("FH 30 O.Orders").Select
Range("A2").PasteSpecial Paste:=xlPasteValues
Range("G2").Select


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 18
'Closing the workbook
Workbooks("Open Order Report.xls").Close False


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Step 19
'UPDATE CORE STOCK VIA SAP TAB
Sheets("SAP").Select
Range("AI3:AK3").Select
Range(Selection, Selection.End(xlDown)).Copy


Range("A3").Select


'Finding the last row for pasting
LastRow = ActiveCell.End(xlDown).Row + 1


Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."




'Step 20
'Select Current Tab As Finished
Sheets("CURRENT").Select


Range("A1").Select


'Saving the workbook
ActiveWorkbook.Save


'Code for Status bar
CompletedPercentage = CompletedPercentage + 5
Application.StatusBar = CompletedPercentage & " % completed..."


'Message upon Completion
MsgBox "Imports Completed and Document Saved", vbOKOnly + vbInformation, "Thankyou"




End Sub

Regards
Ramandeep Singh
 
Upvote 0
Don't forget the "Application.StatusBar = False" at the end of the code...
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
165
shknbk2
S
C
  • Question
Daily Run data (copy data in loop by daily in worksheet)
Replies
3
Views
156
dermie_72
D
R
  • Solved
How to loop a macro
Replies
2
Views
371
rlcurlee
R
S
  • Solved
VBA does not continue to copy after blank cell
Replies
8
Views
525
jolivanes
jolivanes
S
  • Solved
Change export from .txt to workbook
Replies
1
Views
58
HighAndWilder
H

Forum statistics

Threads
1,214,872
Messages
6,122,026
Members
449,061
Latest member
TheRealJoaquin

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top