Unable to find error in code - Runtime 1004 error.

[Justplainj]

Hi All

I have the following code and am not able to find the error.

Quite a simple code. It clears the main sheet, then opens workbooks in a saved location and then copies the data.
However, once it gets to the line "Set owb = Workbooks.Open(sPath & sFil)" which opens the workbook it gives me a runtime error.

It does open the workbook before giving the error, but due to the error it does not continue.
I used this code before and had not issues until now.

the location where the documents are saved is within the documents folder on my PC which is backed up to one drive, in case that information is usefull.
I am using the most up to date office 365 on Windows 11.

Thanks J

Option Explicit
Sub OpenRunCode() 'Open files run Excel VBA macro
Dim sPath As String
Dim sFil As String
Dim owb As Workbook
Dim LastRow As Long
Dim X As Integer
Dim sht As String

Worksheets("CombinedLeaveTaken").Select

sPath = "redacted" 'Gets folder location reports are saved to
If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 'Checks if the location ends with a backslash

sFil = Dir(sPath & "*.xl*") 'Captures all XL files in a directory.

Worksheets("CombinedLeaveTaken").Select
Range("A2:J2").Select
Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Range("A1").Select

Do While sFil <> "" 'Loop through all files in Folder
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

Set owb = Workbooks.Open(sPath & sFil) 'opens the workbook. make sure it is not encrypted or protected with a password

Windows(sFil).Activate 'Activates workbook within folder specified

Cells.Select
Selection.UnMerge

'Adds column before column A
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A8").Select
ActiveCell.FormulaR1C1 = "Company"

'specify company name
Range("A10").Select
ActiveCell.Formula = "=RIGHT($B$2,LEN($B$2)-10)"

Range("A10").Select
Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown))

Range("A10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

'delete unneccesary rows
Rows("9:9").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp

'Select range to copy
    Range("A9:J9").Select
    'Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

'pastes information to the main workbook
ThisWorkbook.Activate
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(LastRow, 1).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Workbooks(sFil).Close SaveChanges:=False

Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

sFil = Dir
Loop

'Removes Duplicates
    Range("A2:H2").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5 _
        , 6, 7, 8), Header:=xlYes
    Range("A1").Select

ThisWorkbook.Save

End Sub

 

[rlv01]

It does open the workbook before giving the error, but due to the error it does not continue.

It probably does open a workbook, but because you are using a loop to open multiple workbooks it is probably not that one causing the issue. Recommend you add some code to trap the error (not tested):

        If Not FSO_ExistFile(sPath & sFil) Then
            MsgBox "File not found:" & vbCr & sPath & sFil, vbOKOnly Or vbExclamation, "File Error"
            Exit Sub
        End If

        On Error Resume Next
        Set owb = Workbooks.Open(sPath & sFil)        'opens the workbook. make sure it is not encrypted or protected with a password
        On Error GoTo 0
       
        If owb Is Nothing Then
            MsgBox "Workbook " & sFil & "could not be opened", vbOKOnly Or vbExclamation, "Workbook Open Error"
            Exit Sub
        End If

''' Simple test for file existance using the File System Object. True if file exists
Function FSO_ExistFile(ByVal FilePath As String) As Boolean
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO_ExistFile = FSO.FileExists(FilePath)
End Function

 

[Justplainj]

Hi rlv01

Thank you for the reply. It did help.
I have rewritten the code and to do further testing i only use one file within the directory where the files are stored.

I re wrote the code just to test the opening and formatting of the workbooks the data will be copied from. (see full code below)
I added ActiveSheet at various areas which seem to have also been the problem, however the code still crashes at the end at the following line.

ActiveSheet.Range("A2").AutoFill Destination:=Range("A2:A" & LastRow), Type:=xlFlashFill

Any help will be appretiated.

Thanks J


Full Code

Option Explicit
Sub OpenRunCode() 'Open files run Excel VBA macro
Dim sPath As String
Dim sFil As String
Dim owb As Workbook
Dim LastRow As Long

Worksheets("CombinedLeaveTaken").Select

sPath = Sheets("CombinedLeaveTaken").Range("K1") 'Gets folder location reports are saved to
If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 'Checks if the location ends with a backslash

sFil = Dir(sPath & "*.xl*") 'Captures all XL files in a directory.

Worksheets("CombinedLeaveTaken").Select
Range("A2:J2").Select
Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Range("A1").Select


Do While sFil <> "" 'Loop through all files in Folder
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

Set owb = Workbooks.Open(sPath & sFil)  'opens the workbook. make sure it is not encrypted or protected with a password

ActiveSheet.Cells.Select
Selection.UnMerge

'Adds column before column A
ActiveSheet.Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


'Add new header
ActiveSheet.Range("A8").Select
ActiveCell.FormulaR1C1 = "Company"


'specify company name
ActiveSheet.Range("A10").Select
ActiveCell.Formula = "=RIGHT($B$2,LEN($B$2)-10)"

ActiveSheet.Range("A10").Select
Selection.Copy
'Range("A10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

ActiveSheet.Rows("9:9").Delete
ActiveSheet.Rows("1:7").Delete

ActiveSheet.Range("A2").Select
LastRow = Range("B" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A2").AutoFill Destination:=Range("A2:A" & LastRow), Type:=xlFlashFill

sFil = Dir
Loop


End Sub

 

[Justplainj]

Hi,

I have also tried the following autofill, removed the loop and moved the files to not be within one drive and I still get the runtime 1004 error.
Basically, trying everything I can and not sure why the error is happening.

Selection.AutoFill Destination:=Range("A2:A" & LastRow)

Also tried is as a basic range i.e.

ActiveSheet.Range("A2").AutoFill Destination:=Range("A2:A10")

Still not working.

So confused.

Thanks J

 

[Justplainj]

HI,

I have overcome the autofill issue by using the following code.

ActiveSheet.Range("A2").Select
LastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Selection.Copy
ActiveSheet.Range("A2:A" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Thanks J