I have a macro that opens each excel in a folder do do some data processing. Now I have a error Invalid procedure call or argument
around the line xFile=Dir
. And I noticed that the second time it opened the same first file, then just throwing this error.
Dim xStrPath As String
Dim xFile As String
Dim xExtension As String
Dim wb As Workbook
xStrPath = "D:\OneDrive\Projects\TEST\"
' xExtension = "\*.xls"
xFile = Dir(xStrPath & "\*.xls")
Do While Len(xFile) > 0
Set wb = Workbooks.Open(Filename:=xStrPath & "\" & xFile) 'open file
Call SplitData
wb.Close SaveChanges:=False 'close the file
xFile = Dir 'Get next file name
Loop
Update
Thanks everyone for your help. Now I know the error is because the SplitData
Call. I will post SplitData
MACRO here, if anyone has time, please help me check this. The SplitData
itself works fine, Don't know why it will lead to this error. Thanks!
And basically SplitData is used to split one worksheet into different worksheets based on one column value, then save this exported worksheet as new workbook. If the workbook exists, copy and paste after the existing one.
Sub SplitData()
'Error Handling will stop on any error
On Error Goto errHandler
If False Then
errHandler:
msgBox err.Description
Exit Sub
End If
'End of Error Handler
' UN MERGE
Dim cell As Range, joinedCells As Range
For Each cell In Range("E4:I60")
If cell.MergeCells Then
Set joinedCells = cell.MergeArea
cell.MergeCells = False
joinedCells.Value = cell.Value
End If
Next
' Split to worksheets
Const NameCol = "B"
Const HeaderRow = 3
Const FirstRow = 4
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Device As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
If IsEmpty(SrcSheet.Cells(SrcRow, NameCol).Value) Then Exit For
Device = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Device)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Device
SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Next SrcRow
' NO SAVE!
Application.ScreenUpdating = True
' Export worksheet
Dim Pointer As Long
Dim FilePath As String
Set MainWorkBook = ActiveWorkbook
Range("E4").Value = MainWorkBook.Sheets.Count
Application.ScreenUpdating = False 'enhance the performance
For Pointer = 2 To MainWorkBook.Sheets.Count
Set NewWorkbook = Workbooks.Add
MainWorkBook.Sheets(Pointer).Copy After:=NewWorkbook.Sheets(1)
Application.DisplayAlerts = False
NewWorkbook.Sheets(1).Delete
Application.DisplayAlerts = False
With NewWorkbook
Filename = "D:\LIDA7\OneDrive - Orient Overseas Container Line Ltd\Projects\9. Hardware_List\TEST\" & MainWorkBook.Sheets(Pointer).Name & ".xls"
FilePath = Dir(Filename)
' if file does not exist, save as new file name
If FilePath = "" Then
.SaveAs Filename
NewWorkbook.Close (0)
' if file exists, copy the new workbook content to the existing file
Else
Dim newlast As String ' new workbook last row
Dim originlast As String
Dim wb As Workbook
Dim rng1 As Range
' select the current new workbook data
newlast = NewWorkbook.Sheets(1).Cells(Sheets(1).Rows.Count, "B").End(xlUp).Row
Set rng1 = Range("A4" & newlast)
rng1.Select
Selection.Copy
' paste in existing file's last row
Set wb = Workbooks.Open(Filename)
originlast = wb.Sheets(1).Cells(Sheets(1).Rows.Count, "B").End(xlUp).Row
wb.Sheets(1).Range("B" & originlast).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = False
wb.Close True
End If
End With
Next Pointer
Application.ScreenUpdating = True
End Sub
So apparently if looping with Dir() when Dir() is called in a sub will break code flow. I know where the problem is, will post the solution if solved my bug.
update
Here's the solution. I referred to the answer here. Thanks a lot.
' looping with dir when dir is called in sub will break the code
' solution: use first loop to store the filename
Dim myArray() As String
ReDim myArray(0)
While (xFile <> "")
ReDim Preserve myArray(UBound(myArray) + 1)
myArray(UBound(myArray)) = xFile
xFile = Dir()
Wend
' second loop, used store array to call sub
Dim n As Integer
For n = 1 To UBound(myArray)
Set wb = Workbooks.Open(Filename:=xStrPath & "\" & myArray(n)) 'open file
Call SplitData
wb.Close SaveChanges:=False
Next