PDA

View Full Version : How to exit loop



YellowLabPro
07-30-2007, 06:01 PM
My code is looking through all the workbooks in a directory, once it does this it loops through and copies all Sheet1 sheets to Masterworkbook.xls

But the loop loops through and picks up on the Masterworkbook.xls and wants to process this book to. I want it to exit out.

I thought by placing this line in the code it would ignore the target book: Line 90 of the first block.

If vFName <> WBm.Name Then GetReportData vFName



Option Explicit
Sub PrepareFiles()
Dim Master As Workbook
Dim WBm As Workbook
Dim wbks As Workbook
Dim Wks As Long, i As Long
Dim LRowM As Long
Dim vFName As Variant
Const FileDirectory As String = "C:\Documents and Settings\Doug\Desktop\ForEach\"
10 Set WBm = Workbooks("MasterWorkbook.xls")
20 With Application.FileSearch
30 .NewSearch
40 .LookIn = FileDirectory
50 .SearchSubFolders = False
60 .FileType = msoFileTypeExcelWorkbooks
70 If .Execute > 0 Then
80 For Each vFName In .FoundFiles
90 If vFName <> WBm.Name Then GetReportData vFName
100 Next
110 Else
120 MsgBox "There were no Excel files found."
130 End If
140 End With
End Sub
Sub GetReportData(wbkName)
Dim Wsm As Worksheet
Dim Ws As Worksheet
Dim strFileName As String
Dim WB As String
Dim Sheet1 As String
10 Set Wsm = Workbooks("MasterWorkbook.xls").Worksheets("Summary")
20 Workbooks.Open Filename:=wbkName, IgnoreReadOnlyRecommended:=True
30 With ActiveWorkbook
40 With Worksheets("Sheet1")
50 .Copy after:=Wsm

60 strFileName = Mid$(wbkName, InStrRev(wbkName, "\") + 1)

70 ActiveSheet.Name = Left$(Left$(strFileName, Len(strFileName) - 4), 23) & Chr(32) & Format(Now, "m-dd-yy")
80 End With
90 .Close savechanges:=False
100 End With

End Sub

YellowLabPro
07-30-2007, 06:08 PM
The other item I would like to do is sort the sheets alphabetically after the loop has finished. This may be accomplished on the front side from the loop to find all the workbooks and loop backwards to copy the sheets into the target workbook, but I am not clear on how to do this.
The other way is to setup a counter and tell it i+1, something of that nature I am thinking.

malik641
07-30-2007, 06:25 PM
Quick question, does MasterWorkbook.xls contain this code? I ask because you can use ThisWorkbook rather than explicitly calling out the Filename.

YellowLabPro
07-30-2007, 06:25 PM
yes, it is in there

malik641
07-30-2007, 07:04 PM
Ok, check it out. Thankfully I had saved a "Sort_Sheets" VBA code module I found somewhere on the internet sometime ago, so I didn't have to rewrite it :):
Option Explicit

Public Sub PrepareWorkbook()
Dim wbMaster As Excel.Workbook
Dim i As Long
Const strFileDirectory As String = _
"C:\Documents and Settings\Doug\Desktop\ForEach\"

Set wbMaster = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = strFileDirectory
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> wbMaster.FullName Then _
Call GetReportData(.FoundFiles(i))
Next

' Sort the sheets
Call SortSheets(wbMaster)
Else
MsgBox "There were no excel files found.", vbInformation, _
"No Excel Files Found in """ & _
strFileDirectory & """."
End If
End With
End Sub

Private Sub GetReportData(ByVal strWkbName As String)
Dim wsMasterSheet As Excel.Worksheet
Dim wbCopyFrom As Excel.Workbook
Dim wsCopiedSheet As Excel.Worksheet
Dim strFileName As String

Set wsMasterSheet = ThisWorkbook.Worksheets("Summary")

Set wbCopyFrom = Workbooks.Open(Filename:=strWkbName, _
IgnoreReadOnlyRecommended:=True)

' Check if Sheet1 exists
If SheetExists(wbCopyFrom, "Sheet1") = True Then
Set wsCopiedSheet = wbCopyFrom.Worksheets("Sheet1").Copy(After:=wsMasterSheet)

With Strings
strFileName = .Mid$(strWkbName, .InStrRev(strWkbName, "\") + 1)
wsCopiedSheet.Name = .Left$(.Left$(strFileName, .Len(strFileName) - 4), 23)
End With
End If

wbCopyFrom.Close SaveChanges:=False
End Sub

Public Function SheetExists(ByVal xlWB As Excel.Workbook, ByVal shName As String) As Boolean
' Determines if a worksheet exists in the workbook
Dim ws As Object
On Error Resume Next
Set ws = xlWB.Sheets(shName)
If Err = 0 Then SheetExists = True Else SheetExists = False
End Function

Public Sub SortSheets(ByRef wbSortSheets As Excel.Workbook)
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
On Error Resume Next

Dim SheetNames() As String
Dim SheetCount As Integer
Dim i As Integer
Dim OldActive As Object

SheetCount = wbSortSheets.Sheets.Count
If Err <> 0 Then Exit Sub 'No Active Workbook

'Check for protected workbook structure
If wbSortSheets.ProtectStructure Then
MsgBox wbSortSheets.Name & " is protected.", _
vbCritical, "Cannot Sort Sheets."
Exit Sub
End If

ReDim SheetNames(1 To SheetCount)

'Store a reference to the active sheet
Set OldActive = ActiveSheet

For i = 1 To SheetCount
SheetNames(i) = wbSortSheets.Sheets(i).Name
Next i

Call BubbleSort(SheetNames)

For i = 1 To SheetCount
wbSortSheets.Sheets(SheetNames(i)).Move _
wbSortSheets.Sheets(i)
Next i

'Reactivate the original active sheet
OldActive.Activate
Set OldActive = Nothing
Application.ScreenUpdating = True
End Sub

Sub BubbleSort(ByRef List() As String)
'Sorts the List array in Ascending Order
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Variant
First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If List(i) > List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub

A few pointers:

I would not use Sheet1 as a variable name. It's the default object-name for the first sheet in every workbook. If you were to use that variable (I didn't see it used in your code), you would run into an error for sure.

You should check to see if "Sheet1" even exists for each workbook you check. I've added that for you.

I've removed unnecessary code for you (unless you used it elsewhere that you didn't post in post #1. In which case, just incorporate my code into yours or vice versa).

Try to use better variable names for easy understanding of what's what. Even if it is 15 characters long, it could really help for future use of projects. Plus, if someone else looks at your code, they have an easier time of understanding what's going on.


This code is untested, but I'm pretty sure it'll work :) Let me know please!

malik641
07-30-2007, 07:08 PM
Small correction on the GetReportData procedure:
Private Sub GetReportData(ByVal strWkbName As String)
Dim wsMasterSheet As Excel.Worksheet
Dim wbCopyFrom As Excel.Workbook
Dim wsCopiedSheet As Excel.Worksheet
Dim strFileName As String

Set wsMasterSheet = ThisWorkbook.Worksheets("Summary")

Set wbCopyFrom = Workbooks.Open(Filename:=strWkbName, _
IgnoreReadOnlyRecommended:=True)

' Check if Sheet1 exists
If SheetExists(wbCopyFrom, "Sheet1") = True Then
Set wsCopiedSheet = wbCopyFrom.Worksheets("Sheet1").Copy(After:=wsMasterSheet)

strFileName = Strings.Mid$(strWkbName, Strings.InStrRev(strWkbName, "\") + 1)
wsCopiedSheet.Name = Strings.Left$(Strings.Left$(strFileName, Strings.Len(strFileName) - 4), 23)
End If

wbCopyFrom.Close SaveChanges:=False
End Sub

malik641
07-30-2007, 07:23 PM
One more correction in GetReportData:

Set wsCopiedSheet = wbCopyFrom.Worksheets("Sheet1").Copy(After:=wsMasterSheet.Name)

I forgot the wsMasterSheet.Name. Sorry about that.

malik641
07-30-2007, 07:40 PM
Scratch that. I forgot you can't (or at least I can't) set a worksheet object to a newly copied sheet in the same line (post #7)...so here's the whole code again...except this time it's tested :):
Option Explicit

Public Sub PrepareWorkbook()
Application.ScreenUpdating = False

Dim wbMaster As Excel.Workbook
Dim i As Long
' Const strFileDirectory As String = _
' "C:\Documents and Settings\Doug\Desktop\ForEach\"
Const strFileDirectory As String = _
"E:\Development\TestFolder\"

Set wbMaster = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = strFileDirectory
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> wbMaster.FullName Then _
Call GetReportData(.FoundFiles(i))
Next

' Sort the sheets
Call SortSheets(wbMaster)
Else
MsgBox "There were no excel files found.", vbInformation, _
"No Excel Files Found in """ & _
strFileDirectory & """."
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub GetReportData(ByVal strWkbName As String)
Dim wsMasterSheet As Excel.Worksheet
Dim wbCopyFrom As Excel.Workbook
Dim wsCopiedSheet As Excel.Worksheet
Dim strFileName As String

'Set wsMasterSheet = ThisWorkbook.Worksheets("Summary")
Set wsMasterSheet = ThisWorkbook.Worksheets("Sheet1")

Set wbCopyFrom = Workbooks.Open(Filename:=strWkbName, _
IgnoreReadOnlyRecommended:=True)

' Check if Sheet1 exists
If SheetExists(wbCopyFrom, "Sheet1") = True Then
wbCopyFrom.Worksheets("Sheet1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set wsCopiedSheet = ActiveSheet

strFileName = Strings.Mid$(strWkbName, Strings.InStrRev(strWkbName, "\") + 1)
wsCopiedSheet.Name = Strings.Left$(Strings.Left$(strFileName, Strings.Len(strFileName) - 4), 23)
End If

wbCopyFrom.Close SaveChanges:=False
End Sub

Public Function SheetExists(ByVal xlWB As Excel.Workbook, ByVal shName As String) As Boolean
' Determines if a worksheet exists in the workbook
Dim ws As Object
On Error Resume Next
Set ws = xlWB.Sheets(shName)
If Err = 0 Then SheetExists = True Else SheetExists = False
End Function

Public Sub SortSheets(ByRef wbSortSheets As Excel.Workbook)
'Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
On Error Resume Next

Dim SheetNames() As String
Dim SheetCount As Integer
Dim i As Integer
Dim OldActive As Object

SheetCount = wbSortSheets.Sheets.Count
If Err <> 0 Then Exit Sub 'No Active Workbook

'Check for protected workbook structure
If wbSortSheets.ProtectStructure Then
MsgBox wbSortSheets.Name & " is protected.", _
vbCritical, "Cannot Sort Sheets."
Exit Sub
End If

ReDim SheetNames(1 To SheetCount)

'Store a reference to the active sheet
Set OldActive = ActiveSheet

For i = 1 To SheetCount
SheetNames(i) = wbSortSheets.Sheets(i).Name
Next i

Call BubbleSort(SheetNames)

For i = 1 To SheetCount
wbSortSheets.Sheets(SheetNames(i)).Move _
wbSortSheets.Sheets(i)
Next i

'Reactivate the original active sheet
OldActive.Activate
Set OldActive = Nothing
'Application.ScreenUpdating = True
End Sub

Sub BubbleSort(ByRef List() As String)
'Sorts the List array in Ascending Order
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Variant
First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If List(i) > List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub