PDA

View Full Version : VBA Loop help (Error Loop without Do)



InzieBear
01-26-2017, 02:39 AM
I'm trying to create a VBA to open all files in a folder, copy the sheet named "Weekly Forecast" and place it into the tab named after the file.... [File name "Weekly Forecast E0462" tab "E0462" : File name "Weekly Forecast E1262" tab "E1262" for example]

Ive got the vba below and it looks like it would work...but I keep getting a Loop without Do bug error.
Can someone help ?





Sub LoopAllExcelFilesInFolder()

Dim wb As Workbook
Dim ws As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim buf As String
Dim shn As String
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open(Filename:=myPath & myFile)
Set y = Workbooks("Weekly_Forecast_Dashboard.xlsm")
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "C:\Users\10053845\Desktop\Trial\Source Files"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
Set wb = Workbooks("Weekly_Forecast_Dashboard.xlsm")
'In Case of Cancel
NextCode:
myPath = wb.Path & "/"
buf = Dir(myPath & "Weekly_Forecast_E*.XLsx")
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While buf <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
Set ws = Workbooks.Open(myPath & buf).Sheets("Weekly Forecast")
shn = Mid(Split(buf, "_")(2), 1, 5)



'Ensure Workbook has opened before moving on to next line of code
DoEvents

'Copy Selected range
With wb.Worksheets(shn)
.Range("B22:H46").Value = ws.Range("B22:H46").Value
.Range("J22:J46").Value = ws.Range("J22:J46").Value
.Range("B69:H71").Value = ws.Range("B69:H71").Value
.Range("J69:J71").Value = ws.Range("J69:J71").Value
.Range("B75:H77").Value = ws.Range("B75:H77").Value
.Range("J75:J77").Value = ws.Range("J75:J77").Value

'Save and Close Workbook
wb.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop

'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

GTO
01-26-2017, 03:56 AM
Cross-posted and answered Here (https://www.mrexcel.com/forum/excel-questions/987721-visual-basic-applications-error-loop-without-do.html)

Inziebear - Please read This Article (http://www.excelguru.ca/content.php?184)

Paul_Hossler
01-26-2017, 09:11 AM
You missed an 'End With'

Formatting with indent level and adding a blank line between logical blocks makes it much easier to see things like that





Option Explicit


Sub LoopAllExcelFilesInFolder()

Dim wb As Workbook
Dim ws As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim buf As String
Dim shn As String
Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open(Filename:=myPath & myFile)
Set y = Workbooks("Weekly_Forecast_Dashboard.xlsm")

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "C:\Users\10053845\Desktop\Trial\Source Files"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
Set wb = Workbooks("Weekly_Forecast_Dashboard.xlsm")

'In Case of Cancel
NextCode:

myPath = wb.Path & "/"
buf = Dir(myPath & "Weekly_Forecast_E*.XLsx")

If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"

'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
Do While buf <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
Set ws = Workbooks.Open(myPath & buf).Sheets("Weekly Forecast")
shn = Mid(Split(buf, "_")(2), 1, 5)



'Ensure Workbook has opened before moving on to next line of code
DoEvents

'Copy Selected range
With wb.Worksheets(shn)
.Range("B22:H46").Value = ws.Range("B22:H46").Value
.Range("J22:J46").Value = ws.Range("J22:J46").Value
.Range("B69:H71").Value = ws.Range("B69:H71").Value
.Range("J69:J71").Value = ws.Range("J69:J71").Value
.Range("B75:H77").Value = ws.Range("B75:H77").Value
.Range("J75:J77").Value = ws.Range("J75:J77").Value
End With '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'Save and Close Workbook
wb.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
DoEvents

'Get next file name
myFile = Dir
Loop

'Message Box when tasks are completed
MsgBox "Task Complete!"

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub







Edit:



Cross-posted and answered Here (https://www.mrexcel.com/forum/excel-questions/987721-visual-basic-applications-error-loop-without-do.html)

Inziebear - Please read This Article (http://www.excelguru.ca/content.php?184)


I didn't see GTO's post - THAT'S why we like to know about a multi-post so that if it's solved, then we don't need to waste time and effort on a non-problem

Aussiebear
01-26-2017, 10:33 AM
Its a shame about the cross posting... Why is it the people cannot understand that VBA is not that big of an internet issue that members here are also members of other forums? You cannot hide if you are chasing issues with vba.... My guess is that it comes done to moral integrity. Or the lack thereof!

Paul_Hossler
01-26-2017, 12:20 PM
@Aussiebear --

I was going to volunteer my 2 cents here, but I put them in the mod forum instead

mana
01-27-2017, 07:13 AM
Sorry.
Perhaps InzieBear got hurried because I was not able to answer .
Simplifying and looping VBA (http://Sorry. Perhaps InzieBear got hurried because I was not able to answer Simplifying and looping VBA)