PDA

View Full Version : [SOLVED] Baffled by Runtime Error 1004 - Help Please



Poundland
02-06-2017, 05:07 AM
Hi Guys,

I am being thwarted by a baffling Runtime Error 1004, it only happens on 1 code line, commented in the code below, but the baffling part of this is that the same code line is used in the same code stream earlier in the process and works just fine, so I cannot understand when it is called a second time that it produces the error...

Can you enlighten me to the error of my ways.. ;)


Sub Slots_Reporting()
Dim wrkThis As Workbook, shtSummary As Worksheet
Dim wrkSlots As Workbook, shtSlots As Worksheet
Dim pdat As Date
Dim rngDay(1 To 2) As Range, rngData As Range, rngDestn As Range
pdat = VBA.Format(Now() - 1, "dd/mm/yyyy")
Set wrkThis = ThisWorkbook
Set shtSummary = wrkThis.Sheets("Summary")
On Error Resume Next
Application.DisplayAlerts = False
'Set wrkSlots = Workbooks("Slots Reporting " & VBA.Format(pdat, "yymmdd") & ".xlsx") ' Testing Only
Set wrkSlots = Workbooks.Open("I:\H904 Supply Chain\Planning\Reports\Slot Reports\Slots Reporting " & VBA.Format(pdat, "yymmdd") & ".xlsx")
Set wrkSlots = Workbooks.Open("I:\H904 Supply Chain\Planning\Reports\Slot Reports\Slots Reporting " & VBA.Format(pdat, "yymmd") & ".xlsx")
Application.DisplayAlerts = True
On Error GoTo 0
On Error GoTo errorhandler
Set shtSlots = wrkSlots.Sheets("DC Dept Summary")
AA:
' springvale data
Set rngDestn = shtSummary.Cells(40, 3)
With shtSlots.Rows(3)
Set rngDay(1) = .Find("Springvale", LookIn:=xlValues).Offset(32)
Set rngDay(2) = .Find("Springvale", LookIn:=xlValues).Offset(33)
End With
Set rngData = shtSlots.Range(rngDay(1).Address, rngDay(2).Address)
rngData.Copy
rngDestn.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
' wellmans
Set rngDestn = shtSummary.Cells(41, 3)
With shtSlots.Rows(3)
Set rngDay(1) = .Find("Wellmans", LookIn:=xlValues).Offset(32)
Set rngDay(2) = .Find("Wellmans", LookIn:=xlValues).Offset(33)
End With
Set rngData = shtSlots.Range(rngDay(1).Address, rngDay(2).Address)
rngData.Copy
rngDestn.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
' harlow
Set rngDestn = shtSummary.Cells(42, 3)
With shtSlots.Rows(3)
Set rngDay(1) = .Find("Harlow", LookIn:=xlValues).Offset(32)
Set rngDay(2) = .Find("Harlow", LookIn:=xlValues).Offset(33)
End With
Set rngData = shtSlots.Range(rngDay(1).Address, rngDay(2).Address)
rngData.Copy
rngDestn.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
' wigan
Set rngDestn = shtSummary.Cells(43, 3)
With shtSlots.Rows(3)
Set rngDay(1) = .Find("WIG", LookIn:=xlValues).Offset(32)
Set rngDay(2) = .Find("WIG", LookIn:=xlValues).Offset(33)
End With
Set rngData = shtSlots.Range(rngDay(1).Address, rngDay(2).Address)
rngData.Copy
rngDestn.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
wrkSlots.Close False
Exit Sub
errorhandler:
pdat = pdat - 2
On Error Resume Next
Application.DisplayAlerts = False
'Set wrkSlots = Workbooks("Slots Reporting " & VBA.Format(pdat, "yymmdd") & ".xlsx") ' Testing Only
Set wrkSlots = Workbooks.Open("I:\H904 Supply Chain\Planning\Reports\Slot Reports\Slots Reporting " & VBA.Format(pdat, "yymmdd") & ".xlsx") ' Produces 1004 Runtime Error
Set wrkSlots = Workbooks.Open("I:\H904 Supply Chain\Planning\Reports\Slot Reports\Slots Reporting " & VBA.Format(pdat, "yymmd") & ".xlsx")
Set shtSlots = wrkSlots.Sheets("DC Dept Summary")
Application.DisplayAlerts = True
On Error GoTo 0
GoTo AA
End Sub

snb
02-06-2017, 05:15 AM
I'd prefer some sample workbooks.
Your code isn't exactly 'mean and lean'.

Poundland
02-06-2017, 05:32 AM
Workbook attached with the original Code on.

The workbook the affected code is trying to open is too large to attach.

The code worked through fine all last week, it has only been today where it has failed. The workbook it needs to open exists and is opened by the second code line after the error line.

What I do not understand is why the same code line, albeit with a different date, that appears earlier in the code runs fine with no error yet on the second attempt with a different date it fails.

snb
02-06-2017, 06:47 AM
To be honest: it's a 'mer à boire'.


Sub Slots_Reporting()
c01 = "I:\H904 Supply Chain\Planning\Reports\Slot Reports\Slots Reporting "

c02 = Dir(c01 & Format(Date - 1, "yymmdd") & ".xlsx")
If c02 = "" Then c02 = Dir(c01 & Format(Date - 1, "yymmd") & ".xlsx")
If c02 = "" Then c02 = Dir(c01 & Format(Date - 2, "yymmdd") & ".xlsx")
If c02 = "" Then c02 = Dir(c01 & Format(Date - 2, "yymmd") & ".xlsx")

With GetObject(c01 & c02).Sheets("DC Dept Summary")
ThisWorkbook.Sheets("Summary").Cells(40, 3).Resize(, 2) = Application.Transpose(.Columns(3).Find("Springvale").Offset(32).Resize(2))
ThisWorkbook.Sheets("Summary").Cells(41, 3).Resize(, 2) = Application.Transpose(.Columns(3).Find("Wellmans").Offset(32).Resize(2))
ThisWorkbook.Sheets("Summary").Cells(42, 3).Resize(, 2) = Application.Transpose(.Columns(3).Find("Harlow").Offset(32).Resize(2))
ThisWorkbook.Sheets("Summary").Cells(43, 3).Resize(, 2) = Application.Transpose(.Columns(3).Find("WIG").Offset(32).Resize(2))
End With
End Sub

NB. I can't test becasue of lacking information.
filles with different nameformats (Format(Date - 1, "yymmdd") and Format(Date - 1, "yymmd") ) is an unnecessary complication of the code.

Poundland
02-06-2017, 07:17 AM
SNB,

Thank you for your code, I have incorporated elements of it, namely the workbook selection process into my original code and it appears to have solved this particular issue.

Thanks