Vba Coding - Stop looping after the Last Excel file

[jhabey01]

Hello,
I have the following code which does what I want which is it loops through a directory of excel files insetrs a worksheet based on a name I give it and copies and pasted data from the worksheet called Currentmonth into the new worksheet and deltes the data in CurrentMonth.
However it is not stopping at the last excel file in the folder. Insdtead it opens up the first file again and tries to repaeat the same code. Fortunatley it errors out for me (Cannot rename a sheet to the same name as another sheet...) I The reason is due to it not stopping after the last file in the directory, I do I stop the loop after it does what it is supposed to?
Thanks


Sub Dynamic()
Dim fPath As String
Dim fName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long

Dim Answer$
Answer = Application.InputBox("Enter New Sheet Name: MM-01-YYYY")
'Which folder?
fPath = "F:\Billing Summary\Retail\"

'Turn of the screen
Application.ScreenUpdating = False
'Loop until we run out of files

Do While fName <> ""
'Open the workbook
Set wb = Workbooks.Open(fPath & fName)

ActiveWorkbook.Sheets.Add.Name = Answer
Sheets(Answer).Activate
Application.CutCopyMode = False

Sheets("CurrentMonth").Select
Sheets("Currentmonth").Range("A1:O10000").Select
Selection.Copy

Sheets(Answer).Activate
ActiveSheet.Paste Destination:= _
Sheets(Answer).Range("A" & 1)
Sheets(Answer).Move before:=Sheets(4)
Sheets("CurrentMonth").Select
Sheets("Currentmonth").Range("A1:O10000").Select
Selection.ClearContents
Sheets("currentmonth").Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close

'Increment count for feedback
i = i + 1

'Get next file name
fName = Dir()
Loop
'turn screen back on
Application.ScreenUpdating = True
'Give feedback
MsgBox "All done." & vbNewLine & "Number of files changed: " & i, vbOKOnly, "Run complete"


End Sub

 

[SkipVought]

hi,

I'd use the File System Object

Sub Dynamic()
    Dim fPath As String
    Dim i As Long
    Dim Answer As String
    Dim oFSO As Object, oFolder As Object, oFile As Object
    
    Answer = Application.InputBox("Enter New Sheet Name: MM-01-YYYY")
    'Which folder?
    
    Application.ScreenUpdating = False
    
    fPath = "F:\Billing Summary\Retail\"
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(fPath)
    
    For Each oFile In oFolder.Files
        With Workbooks.Open(oFile.FullName)
        
            .Sheets.Add.Name = Answer
            
            With .Sheets("CurrentMonth")
                .Activate
                .UsedRange.ClearContents
                .Cells(1, "A").Select
            End With
            
            .Save
            .Close
            
            i = i + 1
        End With
    Next
    
    'turn screen back on
    Application.ScreenUpdating = True
    'Give feedback
    MsgBox "All done." & vbNewLine & "Number of files changed: " & i, vbOKOnly, "Run complete"
End Sub

 

[SkipVought]

Sorry, I missed some code...

Sub Dynamic()
    Dim fPath As String
    Dim i As Long
    Dim Answer As String
    Dim oFSO As Object, oFolder As Object, oFile As Object
    
    Answer = Application.InputBox("Enter New Sheet Name: MM-01-YYYY")
    'Which folder?
    
    Application.ScreenUpdating = False
    
    fPath = "F:\Billing Summary\Retail\"
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(fPath)
    
    For Each oFile In oFolder.Files
        With Workbooks.Open(oFile.FullName)
        
            .Sheets.Add.Name = Answer
            
            .Sheets("CurrentMonth").Range("A1:O10000").Copy .Sheets(Answer).Cells(1, "A")
            
            .Sheets(Answer).Move before:=.Sheets(4)
            
            With .Sheets("CurrentMonth")
                .Activate
                .Range("A1:O10000").ClearContents
                .Cells(1, "A").Select
            End With
            
            .Save
            .Close
            
            i = i + 1
        End With
    Next
    
    'turn screen back on
    Application.ScreenUpdating = True
    'Give feedback
    MsgBox "All done." & vbNewLine & "Number of files changed: " & i, vbOKOnly, "Run complete"
End Sub

 

[jhabey01]

Thanks for the above. Thinking about this further I would like to avoid using the following (what if the data extends beyond 10000?):
.Sheets("CurrentMonth").Range("A1:O10000").Copy .Sheets(Answer).Cells(1, "A")
.Sheets(Answer).Move before:=.Sheets(4)
With .Sheets("CurrentMonth")
.Activate
.Range("A1:O10000").ClearContents

Would somthing like the following work?

With Activesheet
.cells(.rows.count,1).end(xlup).entirerow.copy .Sheets(Answer).Cells(1, "A")
.Sheets(Answer).Move before:=.Sheets(4)
With .Sheets("CurrentMonth")
.Activate
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

End With

 

[jhabey01]

I got an error Object does not upport this property or method at this line:
With Workbooks.Open(oFile.FullName)

I made sure the following is checked in my tools:
'Microsoft Scripting Runtime'

 

[SkipVought]

sorry, I was coding from my iPad.

    For Each oFile In oFolder.Files
        With Workbooks.Open(oFile.[highlight #FCE94F]Path[/highlight])
        
            .Sheets.Add.Name = Answer
            
            .Sheets("CurrentMonth").[highlight #FCE94F]UsedRange[/highlight].Copy .Sheets(Answer).Cells(1, "A")
            
            .Sheets(Answer).Move before:=.Sheets(4)
            
            With .Sheets("CurrentMonth")
                .Activate
                .[highlight #FCE94F]UsedRange[/highlight].ClearContents
                .Cells(1, "A").Select
            End With
            
            .Save
            .Close
            
            i = i + 1
        End With
    Next

 

[jhabey01]

Thanks I need to look more in depth at fso. Anyway the code still has the same issue as before where it it opens up the first file again and tries to repeat the same code:
Here is the current code:

Sub DynamicII()
Dim fPath As String
Dim i As Long
Dim Answer As String
Dim oFSO As Object, oFolder As Object, oFile As Object

Answer = Application.InputBox("Enter New Sheet Name: MM-01-YYYY")
'Which folder?

Application.ScreenUpdating = False
fPath = "fPath = "F:\Billing Summary\Retail\"

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(fPath)

For Each oFile In oFolder.Files
With Workbooks.Open(oFile.Path)
.Sheets.Add.Name = Answer
.Sheets("CurrentMonth").UsedRange.Copy .Sheets(Answer).Cells(1, "A")
.Sheets(Answer).Move before:=.Sheets(4)

With .Sheets("CurrentMonth")
.Activate
.UsedRange.ClearContents
.Cells(1, "A").Select
End With
.Save
.Close

i = i + 1
End With
Next

'turn screen back on
Application.ScreenUpdating = True
'Give feedback
MsgBox "All done." & vbNewLine & "Number of files changed: " & i, vbOKOnly, "Run complete"
End Sub

 

[SkipVought]

Please explain exactly what happened and how you know that any file was accessed more than once.

The For Each...Next loop does not repeat any object in the collection.

 

[jhabey01]

Hi and Thanks,
It ended up being the following: Answer = Application.InputBox("Enter New Sheet Name: MM-01-YYYY")
I changed it to: Answer = Format(Date, "MM-YYYY")

One last item:
- If I run the code I want it to be: Current month -1, Current Year. So if I run the in May 2015 the worksheet will be April-2015.


- Like I mentioned earlier I need to look at FSO at bit more closely. What are the advantages of the code you did as opposed to the way I had it?

Here is the final code I have:
Sub Test_Step1()
Dim fPath As String
Dim i As Long
Dim Answer As String
Dim oFSO As Object, oFolder As Object, oFile As Object

Answer = Format(Date, "MM-YYYY")

'Which folder?
fPath = "C:\Users\Monthly Billing\"
Application.ScreenUpdating = False

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(fPath)

For Each oFile In oFolder.Files
With Workbooks.Open(oFile.Path)
ActiveWorkbook.Sheets.Add.Name = Answer
Sheets(Answer).Activate
.Sheets("CurrentMonth").UsedRange.Copy .Sheets(Answer).Cells(1, "A")
.Sheets(Answer).Move before:=.Sheets(4)
With .Sheets("CurrentMonth")
.Activate
.UsedRange.ClearContents
.Cells(1, "A").Select
End With
.Save
.Close
i = i + 1
End With
Next

'turn screen back on
Application.ScreenUpdating = True
'Give feedback
MsgBox "All done." & vbNewLine & "Number of files changed: " & i, vbOKOnly, "Run complete"
End Sub

 

[SkipVought]

It ended up being the following: Answer = Application.InputBox("Enter New Sheet Name: MM-01-YYYY")
I changed it to: Answer = Format(Date, "MM-YYYY")

I still do not understand how changing the manner in which Answer is derived, fixed your loop???

Current month -1:

Answer = Format(DateSerial(Year(Date), Month(Date)-1, 1), "MM-YYYY")

BTW, as a somewhat minor issue, I almost never use the structure, mm-yyyy. Rather yyyy-mm.

First of all this is only TEXT and cannot be directly used in any sort of Date calculation.

But if you were to want to collate these values in any way, the mm-yyyy is TOTALLY useless, while yyyy-mm will collate in the way you might expect.

You are using a sheet tab for each year/month (that's yet another issue that I would strongly question) and the sheet TAB is just used as an identifier and not for calculation. But on a sheet, I would almost never use TEXT to represent a Date. I would use a REAL DATE and then FORMAT to DISPLAY the mm-yyyy or yyyy-mm.