Below is a part of my code from Ron de Bruin's merge data
from all workbook ( fso page).
I put a progress bar to the concatenation Next statement
I want to place a DoEvent code to stop the concatenate Next
statement code running,and then go to the final msgBox.
But I don't know how to do that.Hope somebody like to help.

================================================== ====

'Loop through all files in the array(myFiles)
For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(myReturnedFiles(I))
On Error GoTo 0
If Not mybook Is Nothing Then

'Set SourceRange and check if it is a valid range
On Error Resume Next

With mybook.Sheets(SourceSh)
Set SourceRange = Application.Intersect(.UsedRange,
..Range(FilterRng))
End With

If Err.Number 0 Then
Err.Clear
Set SourceRange = Nothing
Else
'if SourceRange use all columns then skip this file
If SourceRange.Columns.Count = BaseWks.Columns.Count Then
Set SourceRange = Nothing
End If
End If
On Error GoTo 0

If Not SourceRange Is Nothing Then

'Find the last row in BaseWks
rnum = RDB_Last(1, BaseWks.Cells) + 1

With SourceRange.Parent
Set rng = Nothing

'Firstly, remove the AutoFilter
.AutoFilterMode = False

'Filter the range on the FilterField column
SourceRange.AutoFilter Field:=7, _
Criteria1:="=" & WS.Range("A10").Value
SourceRange.AutoFilter Field:=11, _
Criteria1:="=" & WS.Range("B10").Value
SourceRange.AutoFilter Field:=12, _
Criteria1:="=" & WS.Range("C10").Value
SourceRange.AutoFilter Field:=13, _
Criteria1:="=" & WS.Range("D10").Value
SourceRange.AutoFilter Field:=14, _
Criteria1:="=" & WS.Range("E10").Value

With .AutoFilter.Range
'Check if there are results after you use AutoFilter
RwCount = .Columns(1).Cells. _

SpecialCells(xlCellTypeVisible).Cells.Count - 1

If RwCount = 0 Then
'There is no data, only the header
Else
' Set a range without the Header row
Set rng = .Resize(.Rows.Count - 1,
..Columns.Count). _
Offset(1,
0).SpecialCells(xlCellTypeVisible)

If FileNameInA = True Then
'Copy the range and the file name
If rnum + RwCount < BaseWks.Rows.Count Then
BaseWks.Cells(rnum,
"A").Resize(RwCount).Value _
= mybook.Path
rng.Copy BaseWks.Cells(rnum, "B")
End If
Else
'Copy the range
If rnum + RwCount < BaseWks.Rows.Count Then
rng.Copy BaseWks.Cells(rnum, "A")
End If
End If
End If
End With

'Remove the AutoFilter
.AutoFilterMode = False

End With
End If

'Close the workbook without saving
mybook.Close SaveChanges:=False
End If
' Update the percentage completed.
PctDone = I / myCountOfFiles

' Call subroutine that updates the progress bar.
UpdateProgressBar PctDone
'Open the next workbook
Next I

'Set the column width in the new workbook
BaseWks.Columns("A").AutoFit
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
' The task is finished, so unload the UserForm.
Unload UserForm2

With BaseWks
I = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A11:A" & I)
End With

MsgBox "Search Complete." & vbCrLf _
& rng.Count & " record(s) in the bin", vbInformation _
+ vbOKOnly, "Search Complete"

If WS.Range("D19").Value = 1 Then
Windows("Search Result.xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Else
End If

hi shiro,
i don`t know if this is what you`re searching for, but you can
interrupt a running macro with the Esc-key, see EnableCancelKey
inVBA-help.

stefan

shiro wrote:
Below is a part of my code from Ron de Bruin's merge data
from all workbook ( fso page).
I put a progress bar to the concatenation Next statement
I want to place a DoEvent code to stop the concatenate Next
statement code running,and then go to the final msgBox.
But I don't know how to do that.Hope somebody like to help.

================================================== ====

'Loop through all files in the array(myFiles)
For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(myReturnedFiles(I))
On Error GoTo 0
If Not mybook Is Nothing Then

'Set SourceRange and check if it is a valid range
On Error Resume Next

With mybook.Sheets(SourceSh)
Set SourceRange =
Application.Intersect(.UsedRange, .Range(FilterRng))
End With

If Err.Number 0 Then
Err.Clear
Set SourceRange = Nothing
Else
'if SourceRange use all columns then skip this
file If SourceRange.Columns.Count =
BaseWks.Columns.Count Then Set SourceRange
= Nothing End If
End If
On Error GoTo 0

If Not SourceRange Is Nothing Then

'Find the last row in BaseWks
rnum = RDB_Last(1, BaseWks.Cells) + 1

With SourceRange.Parent
Set rng = Nothing

'Firstly, remove the AutoFilter
.AutoFilterMode = False

'Filter the range on the FilterField column
SourceRange.AutoFilter Field:=7, _
Criteria1:="=" & WS.Range("A10").Value
SourceRange.AutoFilter Field:=11, _
Criteria1:="=" & WS.Range("B10").Value
SourceRange.AutoFilter Field:=12, _
Criteria1:="=" & WS.Range("C10").Value
SourceRange.AutoFilter Field:=13, _
Criteria1:="=" & WS.Range("D10").Value
SourceRange.AutoFilter Field:=14, _
Criteria1:="=" & WS.Range("E10").Value

With .AutoFilter.Range
'Check if there are results after you
use AutoFilter RwCount =
.Columns(1).Cells. _

SpecialCells(xlCellTypeVisible).Cells.Count - 1

If RwCount = 0 Then
'There is no data, only the header
Else
' Set a range without the Header row
Set rng = .Resize(.Rows.Count - 1,
.Columns.Count). _
Offset(1,
0).SpecialCells(xlCellTypeVisible)

If FileNameInA = True Then
'Copy the range and the file
name If rnum + RwCount <
BaseWks.Rows.Count Then
BaseWks.Cells(rnum, "A").Resize(RwCount).Value _
= mybook.Path
rng.Copy
BaseWks.Cells(rnum, "B") End If
Else
'Copy the range
If rnum + RwCount <
BaseWks.Rows.Count Then
rng.Copy BaseWks.Cells(rnum,
"A") End If End If
End If
End With

'Remove the AutoFilter
.AutoFilterMode = False

End With
End If

'Close the workbook without saving
mybook.Close SaveChanges:=False
End If
' Update the percentage completed.
PctDone = I / myCountOfFiles

' Call subroutine that updates the progress bar.
UpdateProgressBar PctDone
'Open the next workbook
Next I

'Set the column width in the new workbook
BaseWks.Columns("A").AutoFit
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
' The task is finished, so unload the UserForm.
Unload UserForm2

With BaseWks
I = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A11:A" & I)
End With

MsgBox "Search Complete." & vbCrLf _
& rng.Count & " record(s) in the bin", vbInformation _
+ vbOKOnly, "Search Complete"

If WS.Range("D19").Value = 1 Then
Windows("Search Result.xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Else
End If