Run-time Error '1004'

Hi all,

I've just recorded (what I think is) is a fairly simple macro. It's basically making a few changes to a list of teams, for a number of project reports.

However, a couple of weird things are now occuring (I did this before and it worked fine).

The first oddity is that when I run the macro in another workbook it simply repeats the actions in the source workbook - before it was changing the desired spreadsheet.

Secondly, I am sometimes getting a "Run-time error '1004'". It then says that the 'cell or chart you are trying to change is protected and therefore read only'. What is doubly odd is that I have made sure that I am removing the protection on both the source worksheet and the target worksheet.

I've copy and pasted the macro code below. When I run a debug it points to the coloured text as the source of the problem.

Sub TeamChange()
'
' TeamChange Macro
' Macro recorded 25/01/2006 by RAC User
'
' Keyboard Shortcut: Ctrl+w
'
ActiveSheet.Unprotect
Windows("Monthly Status Report Template v.2.0.xls").Activate
Selection.Copy
Windows("Services Synergy 2 - Sell RAC_BSM to NUGI Base.xls").Activate
Cells.Select
Range("F1").Activate
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=1
Range("A1:R1").Select
Range("R1").Activate
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="team", RefersToR1C1:="=Teams!R1C1:R1C18"
Range("A1:R19").Select
Range("R1").Activate
Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
False
ActiveWindow.LargeScroll ToRight:=-1
ActiveWindow.ScrollColumn = 1
ActiveWindow.LargeScroll Down:=4
Range("A164:E262").Select
ActiveWorkbook.Names.Add Name:="look_up", RefersToR1C1:= _
"=Teams!R164C1:R262C5"
Sheets("Resources").Select
Range("B6").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=team"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ActiveWindow.LargeScroll ToRight:=-1
Selection.AutoFill Destination:=Range("B6:B102"), Type:=xlFillDefault
Range("B6:B102").Select
ActiveWindow.LargeScroll ToRight:=1
ActiveWindow.LargeScroll Down:=-2
ActiveWindow.ScrollRow = 6
Range("T6").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,look_up,2,FALSE)"
Selection.AutoFill Destination:=Range("T6:W6"), Type:=xlFillDefault
Range("T6:W6").Select
Selection.AutoFill Destination:=Range("T6:W102"), Type:=xlFillDefault
Range("T6:W102").Select
ActiveWindow.LargeScroll ToRight:=-1
Range("C102").Select
ActiveWindow.LargeScroll ToRight:=0
Selection.ClearContents
Range("B102").Select
Selection.ClearContents
ActiveWindow.LargeScroll Down:=-3
Sheets("Teams").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Can anyone suggest what I'm doing wrong, or what needs to be changed?

TIA,

SamuelT

Recorded code is all a bit confusing. I have tried to tidy it. Test this and
let us know how it works (save your work before testing)

Sub TeamChange()
Const sOtherBook As String = "Services Synergy 2 - Sell RAC_BSM to NUGI
Base.xls "

ActiveSheet.Unprotect
Windows("Monthly Status Report Template v.2.0.xls").Activate
With Workbooks(sOtherBook)
.Worksheets("Teams").Unprotect
Selection.Copy .Worksheets(1).Range("F1")
.Names.Add Name:="team", _
RefersToR1C1:="=Teams!R1C1:R1C18"
.Range("A1:R19").CreateNames Top:=True
.Names.Add Name:="look_up", _
RefersToR1C1:="=Teams!R164C1:R262C5"
.Sheets("Resources").Select
With .Range("B6").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:= _
xlBetween, Formula1:="=team"
.ShowInput = True
.ShowError = True
End With
.Range("B6").AutoFill Destination:=.Range("B6:B102"),
Type:=xlFillDefault
.Range("T6").FormulaR1C1 = "=VLOOKUP(RC3,look_up,2,FALSE)"
.Range("T6").AutoFill Destination:=.Range("T6:W6"),
Type:=xlFillDefault
.Range("T6:W6").AutoFill Destination:=.Range("T6:W102"),
Type:=xlFillDefault
.Range("C102").ClearContents
.Range("B102").ClearContents
.Sheets("Teams").Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
End With
End Sub



--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"SamuelT" <[email protected]> wrote in
message news:[email protected]...
>
> Hi all,
>
> I've just recorded (what I think is) is a fairly simple macro. It's
> basically making a few changes to a list of teams, for a number of
> project reports.
>
> However, a couple of weird things are now occuring (I did this before
> and it worked fine).
>
> The first oddity is that when I run the macro in another workbook it
> simply repeats the actions in the source workbook - before it was
> changing the desired spreadsheet.
>
> Secondly, I am sometimes getting a "Run-time error '1004'". It then
> says that the 'cell or chart you are trying to change is protected and
> therefore read only'. What is doubly odd is that I have made sure that
> I am removing the protection on both the source worksheet and the
> target worksheet.
>
> I've copy and pasted the macro code below. When I run a debug it points
> to the coloured text as the source of the problem.
>
> Sub TeamChange()
> '
> ' TeamChange Macro
> ' Macro recorded 25/01/2006 by RAC User
> '
> ' Keyboard Shortcut: Ctrl+w
> '
> ActiveSheet.Unprotect
> Windows("Monthly Status Report Template v.2.0.xls").Activate
> Selection.Copy
> Windows("Services Synergy 2 - Sell RAC_BSM to NUGI
> Base.xls").Activate
> Cells.Select
> Range("F1").Activate
> ActiveSheet.Paste
> ActiveWindow.LargeScroll ToRight:=1
> Range("A1:R1").Select
> Range("R1").Activate
> Application.CutCopyMode = False
> ActiveWorkbook.Names.Add Name:="team",
> RefersToR1C1:="=Teams!R1C1:R1C18"
> Range("A1:R19").Select
> Range("R1").Activate
> Selection.CreateNames Top:=True, Left:=False, Bottom:=False,
> Right:= _
> False
> ActiveWindow.LargeScroll ToRight:=-1
> ActiveWindow.ScrollColumn = 1
> ActiveWindow.LargeScroll Down:=4
> Range("A164:E262").Select
> ActiveWorkbook.Names.Add Name:="look_up", RefersToR1C1:= _
> "=Teams!R164C1:R262C5"
> Sheets("Resources").Select
> Range("B6").Select
> With Selection.Validation
> Delete
> Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
> Operator:= _
> xlBetween, Formula1:="=team"
> IgnoreBlank = True
> InCellDropdown = True
> InputTitle = ""
> ErrorTitle = ""
> InputMessage = ""
> ErrorMessage = ""
> ShowInput = True
> ShowError = True
> End With
> ActiveWindow.LargeScroll ToRight:=-1
> Selection.AutoFill Destination:=Range("B6:B102"),
> Type:=xlFillDefault
> Range("B6:B102").Select
> ActiveWindow.LargeScroll ToRight:=1
> ActiveWindow.LargeScroll Down:=-2
> ActiveWindow.ScrollRow = 6
> Range("T6").Select
> ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,look_up,2,FALSE)"
> Selection.AutoFill Destination:=Range("T6:W6"),
> Type:=xlFillDefault
> Range("T6:W6").Select
> Selection.AutoFill Destination:=Range("T6:W102"),
> Type:=xlFillDefault
> Range("T6:W102").Select
> ActiveWindow.LargeScroll ToRight:=-1
> Range("C102").Select
> ActiveWindow.LargeScroll ToRight:=0
> Selection.ClearContents
> Range("B102").Select
> Selection.ClearContents
> ActiveWindow.LargeScroll Down:=-3
> Sheets("Teams").Select
> ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
> Scenarios:=True
> End Sub
>
> Can anyone suggest what I'm doing wrong, or what needs to be changed?
>
> TIA,
>
> SamuelT
>
>
> --
> SamuelT
> ------------------------------------------------------------------------
> SamuelT's Profile:
http://www.excelforum.com/member.php...o&userid=27501
> View this thread: http://www.excelforum.com/showthread...hreadid=504822
>

I don't see red in the NGs.

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"SamuelT" <[email protected]> wrote in
message news:[email protected]...
>
> Thanks Bob.
>
> Just tried to run the macro. I get a 'syntax error' on the line
> coloured red.
>
> Sub TeamChange()
> Const sOtherBook As String = "Services Synergy 2 - Sell RAC_BSM to NUGI
> Base.xls "
>
> ActiveSheet.Unprotect
> Windows("Monthly Status Report Template v.2.0.xls").Activate
> With Workbooks(sOtherBook)
> Worksheets("Teams").Unprotect
> Selection.Copy .Worksheets(1).Range("F1")
> Names.Add Name:="team", _
> RefersToR1C1:="=Teams!R1C1:R1C18"
> Range("A1:R19").CreateNames Top:=True
> Names.Add Name:="look_up", _
> RefersToR1C1:="=Teams!R164C1:R262C5"
> Sheets("Resources").Select
> With .Range("B6").Validation
> Delete
> Add Type:=xlValidateList, _
> AlertStyle:=xlValidAlertStop, _
> Operator:= _
> xlBetween, Formula1:="=team"
> ShowInput = True
> ShowError = True
> End With
> Range("B6").AutoFill Destination:=.Range("B6:B102"),
> Type:=xlFillDefault
> Range("T6").FormulaR1C1 = "=VLOOKUP(RC3,look_up,2,FALSE)"
> Range("T6").AutoFill Destination:=.Range("T6:W6"),
> Type:=xlFillDefault
> Range("T6:W6").AutoFill Destination:=.Range("T6:W102"),
> Type:=xlFillDefault
> Range("C102").ClearContents
> Range("B102").ClearContents
> Sheets("Teams").Protect DrawingObjects:=True, Contents:=True,
> Scenarios:=True
> End With
> End Sub
>
> Cheers,
>
> SamuelT
>
>
> --
> SamuelT
> ------------------------------------------------------------------------
> SamuelT's Profile:
http://www.excelforum.com/member.php...o&userid=27501
> View this thread: http://www.excelforum.com/showthread...hreadid=504822
>