Run-Time Error "9": Script out of Range Workbook_Open Workbooks.activate

[marionffavp]

Hi Everyone,

What I am trying to accomplish is to have an Excel 2013 file that will open and automatically do the following:

1.) Open a different Excel workbook ("Workbook2") from a SharePoint Site as read only.
2.) Apply a filter on two different columns for the ("Workbook2") Excel workbook.
3.) Copy the values from 6 different columns into the next usable row of the originating workbook ("Workbook1").
4.) Remove any duplicates that are found in the first workbook("Workbook1").
5.) close the ("Workbook2") file.

​

The problem I am having is that ("Workbook2") is not getting the filter applied to it, but ("Workbook1") is and that is not what needs to happen. The really funny thing is that it worked perfectly when I stepped through the code using F8. That's what I get for not REALLY testing it out with a final run.


below is the code:

Private Sub Workbook_Open()
'
'
Dim CurWorkbook As Workbook
Dim Workbook1EndRow As Long
Dim Workbook1StartCopyRow As Long
Dim Workbook2EndRow As Long
Dim Workbook1AfterPasteRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set CurWorkbook = ActiveWorkbook

Workbooks.Open "SharePoint Site Link", ReadOnly:=True
Workbooks("Workbook2").Sheets("Sheet1").Activate 'This is where the error occurs.

With ActiveSheet
.AutoFilterMode = False
.UsedRange.AutoFilter
.UsedRange.AutoFilter field:=37, Criteria1:=xlFilterYesterday, Operator:=xlFilterDynamic
.UsedRange.AutoFilter field:=29, Criteria1:="*criteria*"
End With


Workbooks("Workbook1").Sheets("Sheet1").Activate
Workbook1EndRow = Cells(Rows.Count, 1).End(xlUp).Row
Workbook1StartCopyRow = Cells(Rows.Count, 1).End(xlUp).Row + 1


'Copy and paste the values starting from the starting cell number.
'Get the notification number
Range("AD2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Workbooks("Workbook1").Activate
ActiveSheet.Paste Destination:=Cells(Workbook1StartCopyRow, 1)

Application.CutCopyMode = False

'Get the Created on Date
Windows("Workbook2").Activate
Range("AK2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Workbooks("Workbook1").Activate
ActiveSheet.Paste Destination:=Cells(Workbook1StartCopyRow, 2)

Application.CutCopyMode = False

'Get the Serial Number

Windows("Workbook2").Activate
Range("AB2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Workbooks("Workbook1").Activate
ActiveSheet.Paste Destination:=Cells(Workbook1StartCopyRow, 3)

Application.CutCopyMode = False

'Get the Description
Windows("Workbook2").Activate
Range("AC2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Workbooks("Workbook1").Activate
ActiveSheet.Paste Destination:=Cells(Workbook1StartCopyRow, 4)

Application.CutCopyMode = False
'Get the Long Text.
Windows("Workbook2").Activate
Range("K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Workbooks("Workbook1").Activate
ActiveSheet.Paste Destination:=Cells(Workbook1StartCopyRow, 5)

Application.CutCopyMode = False

'Get the Activity Text
Windows("Workbook1").Activate
Range("L2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Workbooks("Workbook1").Activate
ActiveSheet.Paste Destination:=Cells(Workbook1StartCopyRow, 6)

Application.CutCopyMode = False

'Find the duplicate range to remove duplicates from.
Workbook1AfterPasteRow = Cells(Rows.Count, 1).End(xlUp).Row

'remove duplicates.

ActiveSheet.Range("$A:I").RemoveDuplicates Columns:=1, Header:=xlYes


Workbooks("workbook2").Close

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

End Sub

 

[StephenCrump]

The error message simply means that you don't have an open workbook called "Workbook2", e.g. "Workbook2.xls" or "Workbook2.xlsx".

I am guessing that you are trying to do something like this:

Dim Workbook2 As Workbook

Set Workbook2 = Workbooks.Open(Filename:="YourFilenameStringGoesHere", ReadOnly:=True)

 

[marionffavp]

Hi StevenCrump,

Thank you for your speedy response! Your code helped me. At this time, I am running across other issues. Like how to make Excel to check if the day of the week is a Monday and then filter on data from Friday, Saturday and Sunday.

Happy Coding!

Thanks again

 

[marionffavp]

Thanks again StevenCrump! You were most helpful. I did not even think about defining the workbook in Excel VBA. I thought I had coded things before and it was not required or perhaps I did and I'm getting old and forgetting things.
I changed my solution to be an outside Excel file with a command button to click to make the events occur. Below is my solution:
Sub CopyPasteFilterDates()<o></o>
Dim File1EndRow As Long<o></o>
Dim File2StartCopyRow As Long<o></o>
Dim File2EndRow As Long<o></o>
Dim File2AfterPasteRow As Long<o></o>
Dim File2 As Workbook<o></o>
Dim TodaysDate As Date<o></o>
Dim StartDate As Long<o></o>
Dim EndDate As Long<o></o>
<o> </o>
TodaysDate = Date<o></o>
StartDate = Date<o></o>
EndDate = Date - 3<o></o>
<o> </o>
<o> </o>
Application.DisplayAlerts = False<o></o>
Application.ScreenUpdating = False<o></o>
Application.DisplayStatusBar = False<o></o>
Application.EnableEvents = False<o></o>
<o> </o>
<o> </o>
'Apply a filter that will only find items if they have"*items*"anywhere in the Description and yesterday's date.<o></o>
'Open the File1 spreadsheet.<o></o>
<o> </o>
<o> </o>
Set File1Data = Workbooks.Open("SharePoint Site Link/File1.xlsx",ReadOnly:=True)<o></o>
<o> </o>
Workbooks.Open"SharePoint Site Link/File1.xlsx"<o></o>
Workbooks("File2.xlsx").Activate<o></o>
Workbooks.CheckOut"File2.xlsx"<o></o>
<o></o>
With ActiveSheet<o></o>
.AutoFilterMode =False<o></o>
End With<o></o>
<o> </o>
<o> </o>
Workbooks("File1.xlsx").Activate<o></o>
<o> </o>
<o></o>
If WorksheetFunction.Weekday(TodaysDate) <> 2 Then<o></o>
With ActiveSheet<o></o>
.AutoFilterMode = False<o></o>
.UsedRange.AutoFilter<o></o>
.UsedRange.AutoFilter field:=37, Criteria1:=xlFilterYesterday,Operator:=xlFilterDynamic<o></o>
.UsedRange.AutoFilter field:=29, Criteria1:="**"<o></o>
End With<o></o>
<o></o>
Else<o></o>
With ActiveSheet<o></o>
.AutoFilterMode = False<o></o>
.UsedRange.AutoFilter<o></o>
.UsedRange.AutoFilter field:=37, Criteria1:=">=" &EndDate, Operator:=xlAnd, Criteria2:="<=" & StartDate<o></o>
.UsedRange.AutoFilter field:=29,Criteria1:="**"<o></o>
End With<o></o>
End If<o></o>
<o> </o>
<o></o>
<o> </o>
'Find the end of the row in File2 before doing anythingelse.<o></o>
Workbooks("File2.xlsx").Sheets("Sheet1").Activate 'Go to “Sheet1” worksheet of File2.<o></o>
File2EndRow =Cells(Rows.Count, 1).End(xlUp).Row 'Search File2 to find the last unused row.<o></o>
File2StartCopyRow= Cells(Rows.Count, 1).End(xlUp).Row + 1 'Add one to bring the line down onerow.<o></o>
<o> </o>
<o></o>
' ActiveSheet.Range("$A$1:$BE$7128").AutoFilter field:=37,Criteria1:= _<o></o>
' xlFilterYesterday, Operator:=xlFilterDynamic<o></o>
'<o></o>
' ActiveSheet.Range("$A$1:$BE$7128").AutoFilter field:=29,Criteria1:="*items*"<o></o>
'<o></o>
'Copy and paste the values starting from the starting cellnumber.<o></o>
'Get the data startingin cell AD2 to gather all the filtered values only.<o></o>
Windows("File1.xlsx").Activate<o></o>
Range("AD2").Select<o></o>
Range(Selection,Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
<o></o>
Workbooks("File2.xlsx").Activate<o></o>
ActiveSheet.PasteDestination:=Cells(File2StartCopyRow, 1) ‘ Start in the first usable row and incolumn A.<o></o>
<o></o>
Application.CutCopyMode = False<o></o>
<o></o>
'Get the data startingin cell AK2 to gather all the filtered values only.<o></o>
Windows("File1.xlsx").Activate<o></o>
Range("AK2").Select<o></o>
Range(Selection,Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
<o></o>
Workbooks("File2.xlsx").Activate<o></o>
ActiveSheet.PasteDestination:=Cells(File2StartCopyRow, 2) ‘ Start in the first usable row and incolumn B.<o></o>
<o></o>
Application.CutCopyMode = False<o></o>
<o></o>
'Get the data startingin cell AB2 to gather all the filtered values only.<o></o>
<o></o>
Windows("File1.xlsx").Activate<o></o>
Range("AB2").Select<o></o>
Range(Selection,Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
<o></o>
Workbooks("File2.xlsx").Activate<o></o>
ActiveSheet.PasteDestination:=Cells(File2StartCopyRow, 3) ‘ Start in the first usable row and incolumn C.<o></o>
<o></o>
Application.CutCopyMode = False<o></o>
<o></o>
'Get the data startingin cell BB2 to gather all the filtered values only.<o></o>
Windows("File1.xlsx").Activate<o></o>
Range("BB2").Select<o></o>
Range(Selection,Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
<o></o>
Workbooks("File2.xlsx").Activate<o></o>
ActiveSheet.PasteDestination:=Cells(File2StartCopyRow, 4) ‘ Start in the first usable row and incolumn D.<o></o>
<o></o>
Application.CutCopyMode = False<o></o>
<o></o>
'Get the data startingin cell AC2 to gather all the filtered values only.<o></o>
Windows("File1.xlsx").Activate<o></o>
Range("AC2").Select<o></o>
Range(Selection,Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
<o></o>
Workbooks("File2.xlsx").Activate<o></o>
ActiveSheet.PasteDestination:=Cells(File2StartCopyRow, 5) ‘ Start in the first usable row and incolumn E.<o></o>
<o></o>
Application.CutCopyMode = False<o></o>
<o> </o>
'Get the data startingin cell K2 to gather all the filtered values only.<o></o>
Windows("File1.xlsx").Activate<o></o>
Range("K2").Select<o></o>
Range(Selection,Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
<o></o>
Workbooks("File2.xlsx").Activate<o></o>
ActiveSheet.PasteDestination:=Cells(File2StartCopyRow, 6) ‘ Start in the first usable row and incolumn F.<o></o>
<o></o>
Application.CutCopyMode = False<o></o>
<o></o>
'Get the data startingin cell L2 to gather all the filtered values only<o></o>
Windows("File1.xlsx").Activate<o></o>
Range("L2").Select<o></o>
Range(Selection,Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
<o></o>
Workbooks("File2.xlsx").Activate<o></o>
ActiveSheet.PasteDestination:=Cells(File2StartCopyRow, 7) ‘ Start in the first usable row and incolumn G.<o></o>
<o></o>
Application.CutCopyMode = False<o></o>
<o></o>
'Find theduplicate range to remove duplicates from.<o></o>
AfterPasteRow =Cells(Rows.Count, 1).End(xlUp).Row<o></o>
<o></o>
'removeduplicates.<o></o>
ActiveSheet.Range("$A:I").RemoveDuplicates Columns:=1,Header:=xlYes<o></o>
<o></o>
'Close File1.<o></o>
Workbooks("File1.xlsx").Close<o></o>
Windows("File2.xlsx").Activate<o></o>
Workbooks("File2.xlsx").CheckIn<o></o>
<o> </o>
Application.DisplayAlerts = True<o></o>
Application.ScreenUpdating = True<o></o>
Application.DisplayStatusBar = True<o></o>
Application.EnableEvents = True<o></o>
End Sub

Merry Christmas and Happy New Year!!! Very Happy Coding!