Runtime Error 1004 - Active method of range class failed - multiple sheets

[MARK1111]

Good evening all,

I've had a read through various posts but due to my lack of knowledge, it is difficult to determine if others are have the same runtime error as me or not. If anyone has any suggestions, I'd be grateful.

I have a workbook, that originally contained just the one sheet. The intention was always to increase the sheets (one per customer). I asked someone to tweak the sheet so that when the sheet was selected, it automatically scrolled to the correct week. I had some success prior to this using code I found online but the issue I faced was that it assumed the week always started on a Sunday, hence the reason I sought assistance.
After a number of emails, it was clear the person who came up with the code, would no longer assist.
The issue arose when I added further sheets to the workbook. I get the following message:

'Run-time error 1004. Active method of range class failed'

Here is the code that is causing the problems:

 Private Sub Workbook_Open()

Application.EnableEvents = False
Dim weekNum As Long


weekNum = VBAWeekNum(Now(), 1)


Dim wkDay As Long
wkDay = Weekday(Now, vbMonday)


Sheet1.Cells((3 + weekNum) + (weekNum - 1), 3 + wkDay).Activate
Sheet1.Activate
ActiveWindow.ScrollRow = (3 + weekNum) + (weekNum - 1)
'(i + 3) + (i - 1)
Application.EnableEvents = True


End Sub

As I've said, my knowledge is little to nothing so when something goes wrong, I'm lost. Hopefully its something obvious and simple but the fact he refused to assist would lead me to believe it's more time consuming to fix.

Thanks in advance,

Mark

 

[MARK1111]

Change your code to the following

Private Sub Workbook_Open()
    Dim s As Long, u As Long
    WeekNum = WorksheetFunction.WeekNum(Now(), 1)
    ActiveWindow.FreezePanes = False
    Range("A4").Select
    ActiveWindow.FreezePanes = True
    u = Range("B" & Rows.Count).End(xlUp).Row
    Set b = Range("B4:B" & u).Find(WeekNum, LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        ActiveWindow.SmallScroll Down:=b.Row - 4
    End If
End Sub

Try an tell me.

Thanks for taking a look at this and sorry for the delay in responding.
I've just deleted the old code I posted above and replaced it with yours but whilst it no longer throws up an error, it doesn't appear to do anything. This may be down to me and the way I have added it. I can work out how to apply macro's but I suspect that code like that above, works slightly differently? Does it need adding to each sheet or can it be added to the whole project (workbook). I'm conscious that I may be using the wrong terms and that may confuse things further.

 

[DanteAmor]

Thanks for taking a look at this and sorry for the delay in responding.
I've just deleted the old code I posted above and replaced it with yours but whilst it no longer throws up an error, it doesn't appear to do anything. This may be down to me and the way I have added it. I can work out how to apply macro's but I suspect that code like that above, works slightly differently? Does it need adding to each sheet or can it be added to the whole project (workbook). I'm conscious that I may be using the wrong terms and that may confuse things further.

You have to put the code in the events of Thisworkbook, when you open the book it will move the rows until the current week, assuming that you only have one sheet.
If you are on your sheet and you want to make the move, then put this macro in a module and execute it:

Sub scroll()
    Dim s As Long, u As Long
    WeekNum = WorksheetFunction.WeekNum(Now(), 1)
    ActiveWindow.FreezePanes = False
    Range("A4").Select
    ActiveWindow.FreezePanes = True
    u = Range("B" & Rows.Count).End(xlUp).Row
    Set b = Range("B4:B" & u).Find(WeekNum, LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        ActiveWindow.SmallScroll Down:=b.Row - 4
    End If


End Sub

 

[MARK1111]

You have to put the code in the events of Thisworkbook, when you open the book it will move the rows until the current week, assuming that you only have one sheet.
If you are on your sheet and you want to make the move, then put this macro in a module and execute it:

Sub scroll()
    Dim s As Long, u As Long
    WeekNum = WorksheetFunction.WeekNum(Now(), 1)
    ActiveWindow.FreezePanes = False
    Range("A4").Select
    ActiveWindow.FreezePanes = True
    u = Range("B" & Rows.Count).End(xlUp).Row
    Set b = Range("B4:B" & u).Find(WeekNum, LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        ActiveWindow.SmallScroll Down:=b.Row - 4
    End If


End Sub

Thank you so much. That has resolved my issue and allowed me to add a button, to scroll to the current week. You have saved me hours of searching and frustration.
Thank!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.