Excel VBA - Multiple Dir() in Same Folder - excel

Question

I am working on this codes, but can't make it work.
Here is my working code:
Sub AREA21()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim regFile As String
Dim myExtension As String
Dim RegX As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ThisWorkbook.UpdateLinks = xlUpdateLinksNever
myPath = "C:\Users\Aspire E 14\Desktop\xx\xxx\"
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*area trees yield of NFICCs in *.xls*"
RegX = "*area trees yield of NFICCs in REG*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
regFile = Dir(RegX & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
If myFile = regFile Then GoTo skipRegFile
Set wb = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=False)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'my codes here
For i = 1 To Sheets.Count
Sheets(i).Select
Next i
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
skipRegFile:
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
ThisWorkbook.UpdateLinks = xlUpdateLinksAlways
End Sub
Here is the sample folder:
Files with "REG**" are just the summary of respective provinces.
My goal is to run the codes in provincial files, and skip opening the file if it is a regional summary. However, problems occur when getting the next file in Dir statement as it appears blank.
Still looking for a better work around.

Answer 1

You can adapt this code to suit your needs.
Some suggestions:
Name your variables to something meaningful (sh is hard to understand, sourceRange it's easier)
Indent your code properly (you can use Rubberduckvba.com) to help you with data
Try to break your code into pieces (e.g. first validate, then prepare, then add items)
Comment your code
Code:
Public Sub Area21()
' Basic error handling
On Error GoTo CleanFail
' Turn off stuff
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ThisWorkbook.UpdateLinks = xlUpdateLinksNever
' Define files path
Dim filesPath As String
filesPath = "C:\TEMP\"
' Define file name string to match
Dim fileString As String
fileString = "demo"
' Define file name
Dim fileName As String
fileName = Dir(filesPath, vbNormal)
' Loop through files
Do While fileName <> ""
'Set variable equal to opened workbook
If InStr(LCase(fileName), LCase(fileString)) > 0 Then
' Set a reference to the workbook
Dim targetWorkbook As Workbook
Set targetWorkbook = Workbooks.Open(fileName:=filesPath & fileName, UpdateLinks:=False)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
' DO SOMETHING WITH THE WORKBOOK
'Save and Close Workbook
targetWorkbook.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
End If
fileName = Dir()
Loop
CleanExit:
' Turn on stuff
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
ThisWorkbook.UpdateLinks = xlUpdateLinksAlways
Exit Sub
CleanFail:
MsgBox "Error " & Err.Description
GoTo CleanExit
End Sub