hobbiton73
03-05-2013, 11:10 AM
Hi, I wonder whether someone may be able to help me please.
I'm trying to put together a Excel Progress bar using this as a template to work from http://www.learnexcelmacro.com/2012/02/progressbar-in-excel-vba/
I've put together my script for activating and running the progress bar as shown below which are called via a button click.
Private Sub UserForm_Activate()
frmProgressBar.LabelProgress.Width = 0
Call ShowProgressBar
End Sub
Sub ShowProgressBar()
Dim Percent As Integer
Dim PercentComplete As Single
Dim MaxRow, MaxCol As Integer
MaxRow = 500
MaxCol = 100
Percent = 0
For iRow = 1 To MaxRow
For iCol = 1 To MaxCol
Worksheets("Random Numbers").Cells(iRow, iCol).Value = iRow * iCol
Next
PercentComplete = iRow / MaxRow
frmProgressBar.LabelProgress.Width = PercentComplete * frmProgressBar.Width
frmProgressBar.LabelProgress.Caption = Format(PercentComplete, "0%")
DoEvents
Next
Unload frmProgressBar
End Sub
The problem I have is that I can't find a way to incorporate this into my exisiting macro as shown below:
Sub Merge()
Dim DestWB As Workbook
Dim WB As Workbook
Dim ws As Worksheet
Dim SourceSheet As String
Dim startRow As Long
Dim n As Long
Dim dr As Long
Dim lastRow As Long
Dim FileNames As Variant
Sheets("Input").Range("A7:AE1700").Cells.ClearContents
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
startRow = 7
Application.ScreenUpdating = False
Set WB = ThisWorkbook
FileNames = WB.Worksheets("File List").Range("B4:B20").Value
For n = LBound(FileNames, 1) To UBound(FileNames, 1)
Set WB = Workbooks.Open(Filename:=FileNames(n, 1), ReadOnly:=True)
For Each ws In WB.Worksheets
If ws.Name = SourceSheet Then
With ws
If .UsedRange.Cells.Count > 1 Then
dr = DestWB.Worksheets("Input").Range("C" & DestWB.Worksheets("Input").Rows.Count).End(xlUp).Row + 1
lastRow = .Range("C" & Rows.Count).End(xlUp).Row
If lastRow >= startRow Then
.Range("A" & startRow & ":AE" & lastRow).Copy
DestWB.Worksheets("Input").Cells(dr, "A").PasteSpecial xlValues
End If
End If
End With
Exit For
End If
Next ws
Application.CutCopyMode = False
WB.Close savechanges:=False
Next n
Columns("A:S").EntireColumn.AutoFit
End Sub
In their own right, they both work perfectly, but for the last few days I've been trying to incoporate them to work togther.
I thought, perhaps naively, that I could use the following 'Call Merge' to call my main macro within the 'Progress Bar' code. But despite trying this in different positions within the code, I've been unable to get this to work.
I just wondered whether someone may be able to look at this please and let me know where I'm going wrong.
Many thanks and kind regards
Chris
I'm trying to put together a Excel Progress bar using this as a template to work from http://www.learnexcelmacro.com/2012/02/progressbar-in-excel-vba/
I've put together my script for activating and running the progress bar as shown below which are called via a button click.
Private Sub UserForm_Activate()
frmProgressBar.LabelProgress.Width = 0
Call ShowProgressBar
End Sub
Sub ShowProgressBar()
Dim Percent As Integer
Dim PercentComplete As Single
Dim MaxRow, MaxCol As Integer
MaxRow = 500
MaxCol = 100
Percent = 0
For iRow = 1 To MaxRow
For iCol = 1 To MaxCol
Worksheets("Random Numbers").Cells(iRow, iCol).Value = iRow * iCol
Next
PercentComplete = iRow / MaxRow
frmProgressBar.LabelProgress.Width = PercentComplete * frmProgressBar.Width
frmProgressBar.LabelProgress.Caption = Format(PercentComplete, "0%")
DoEvents
Next
Unload frmProgressBar
End Sub
The problem I have is that I can't find a way to incorporate this into my exisiting macro as shown below:
Sub Merge()
Dim DestWB As Workbook
Dim WB As Workbook
Dim ws As Worksheet
Dim SourceSheet As String
Dim startRow As Long
Dim n As Long
Dim dr As Long
Dim lastRow As Long
Dim FileNames As Variant
Sheets("Input").Range("A7:AE1700").Cells.ClearContents
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
startRow = 7
Application.ScreenUpdating = False
Set WB = ThisWorkbook
FileNames = WB.Worksheets("File List").Range("B4:B20").Value
For n = LBound(FileNames, 1) To UBound(FileNames, 1)
Set WB = Workbooks.Open(Filename:=FileNames(n, 1), ReadOnly:=True)
For Each ws In WB.Worksheets
If ws.Name = SourceSheet Then
With ws
If .UsedRange.Cells.Count > 1 Then
dr = DestWB.Worksheets("Input").Range("C" & DestWB.Worksheets("Input").Rows.Count).End(xlUp).Row + 1
lastRow = .Range("C" & Rows.Count).End(xlUp).Row
If lastRow >= startRow Then
.Range("A" & startRow & ":AE" & lastRow).Copy
DestWB.Worksheets("Input").Cells(dr, "A").PasteSpecial xlValues
End If
End If
End With
Exit For
End If
Next ws
Application.CutCopyMode = False
WB.Close savechanges:=False
Next n
Columns("A:S").EntireColumn.AutoFit
End Sub
In their own right, they both work perfectly, but for the last few days I've been trying to incoporate them to work togther.
I thought, perhaps naively, that I could use the following 'Call Merge' to call my main macro within the 'Progress Bar' code. But despite trying this in different positions within the code, I've been unable to get this to work.
I just wondered whether someone may be able to look at this please and let me know where I'm going wrong.
Many thanks and kind regards
Chris