How to copy rows into an Excel *template* with vba

[Guest]

I would run a few more times and see if Q is the problem. Maybe eliminate Q
and see if it consistantly runs. The problem seems releated to the data in
the range of cells and not VBA code. Can you post the formula that is in
cell Q that is causing the problem?

I have three thoughts about this problem
1) There is some sort of circular equation that is causing the problem.
2) There is a reference to another workbook that is causing the problem.
Error 400 is sometimes cause by network files being available.
3) The templet workbook is corrupted. Sometimes copying the worksheet to a
new workbook solves the problem. Copying the workbook usually doesn't
correct these probelms because the error is also copied. You have to copy
the individual worksheets.

I had a workbook that when I opened said there was links that needed to be
updated. Try to find the link and couldn't. Deleted each worksheet except
for one sheet and still had the problem. Search the worksheet and couldn't
find the link. Deleted everything on the worksheet and still was getting the
error when the wrokbook was opened. The error was buried inside the excel
file and couldn't be removed. Copied the worksheets to a new workbook and
didn't get the error.

 

[Guest]

I've managed to establish a pattern for the error. When I OPEN Master.xls and
run the macro for the FIRST time I will surely get this error "Run-time error
'1004' Application-defined or object-defined error" (and in the template
sheet in the newly created workbook the autofill ceases to run at column Q).
The code affected is :

Selection.AutoFill _
Destination:= _
NewTempl.Range(ToRange), _
Type:=xlFillDefault


For any tries after this *without closing Master.xls* the macro runs
smoothly without problem and the autofill is successful.

There is nothing in column Q. Q23 downwards are blank because it is for data
entry (Q1:Q22 are blank or contain headings, field titles, etc). But I know
column Q is linked to other macros in the template (one of it causes cells in
Q to lock & change color if corresponding cell in P is filled and vice versa.
I found this macro caters for single cell changes only and throws an error if
changes happen to multiple cells e.g. when I select more than 1 cell and
clear the contents using delete key). In case this helps, I'll post the code
below....

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

If Not Intersect(Range("P"), Target) Is Nothing Then

ActiveSheet.Unprotect "12345678"

If ((IsEmpty(Target.Value) = False) And (IsNull(Target.Value) = False))
Then


Target.Offset(0, 1).Value = ""
Target.Offset(0, 1).Interior.ColorIndex = 16
Target.Offset(0, 1).Locked = True

If (Target.Offset(0, -10).Value = "300") Then
MsgBox "Please enter comments."
End If

If (Target.Offset(0, -10).Value = "200") And (Target.Offset(0, -9).Value

100) Then

MsgBox "Please enter comments."
End If


Else

Target.Offset(0, 1).Locked = False
Target.Offset(0, 1).Interior.ColorIndex = 36


End If

ActiveSheet.Protect Password:="12345678", userinterfaceonly:=True
ActiveSheet.EnableOutlining = True


End If

If Not Intersect(Range("Q:Q"), Target) Is Nothing Then


ActiveSheet.Unprotect "12345678"


If ((IsEmpty(Target.Value) = False) And (IsNull(Target.Value) = False))
Then

Target.Offset(0, -1).Value = ""
Target.Offset(0, -1).Interior.ColorIndex = 16

Target.Offset(0, -1).Locked = True

If (Target.Offset(0, -11).Value = "300") Then
MsgBox "Please enter comments."
End If

If (Target.Offset(0, -11).Value = "200") And (Target.Offset(0, -10).Value

100) Then

MsgBox "Please enter comments."
End If

Else
Target.Offset(0, -1).Locked = False
Target.Offset(0, -1).Interior.ColorIndex = 36

End If

ActiveSheet.Protect Password:="12345678", userinterfaceonly:=True
ActiveSheet.EnableOutlining = True

End If


Application.EnableEvents = True


End Sub

This macro will run everytime the template is opened:
Private Sub Workbook_open()
With Worksheets("PRODUCT TEMPLATE")
.Protect Password:="12345678", userinterfaceonly:=True
.EnableOutlining = True
End With
End Sub

On your thoughts:
1) Circular reference - excel doesn't prompt me about this. How to do I be
sure ?
2) Reference / link to another workbook - excel doesn't prompt me to update
link when template file is opened. I went cell by cell in A23:BT23 and I
don't see any formulas referencing an external source. Some of the cells
contain UDFs, but the arguments are referencing the cells in the same sheet.
3) Template workbook is corrupt - Am going to try this out. Do I have to
insert new sheet and copy & paste in, or can I right-click the tab and use
the "move & copy" method?

Thanks

 

[Guest]

Copying worksheet using the tab on the bootom is ok.

I'm leaning away from the correupted worksheet because it runs the second
time. thinking more that the focus is on the wrong worksheet/workbook or
there is a timing problem with the unprotect statement.

You said the macro runs the second time. Is this my Test macro or the
actual macro or both. Check if my macro run the second time.

Try slowly stepping through the code using F8. Wait 10 seconds between the
unprotect and the autofill instructions. Lets rule out timing.

I modified the test program to eliminate the select then the autofill. It
now does the autofill in one instruction. see if this makes a difference.

Sub test()

'
Set fs = CreateObject("Scripting.FileSystemObject")
'
With ThisWorkbook.Sheets("MasterList")
Workbooks.Add _
Template:="C:\MasterList\template.xlt"
Set NewBook = ActiveWorkbook
Set NewTempl = NewBook.Sheets("Template")
Set NewTempl1 = NewBook.Sheets("Template1")
NewTempl.Select

On Error GoTo err1
Prod_Count = 5
NewTempl.Unprotect ("12345678")
NewTempl.Activate
For Colcount = 1 To Range("BT23").Column
lastcelladdr = Cells(23, Colcount).Address
FromRange = "A23:" & lastcelladdr
lastcelladdr = Cells(27, Colcount).Address
ToRange = "A23:" & lastcelladdr
NewTempl.Range(FromRange).AutoFill _
Destination:= _
NewTempl.Range(ToRange), _
Type:=xlFillDefault
Next Colcount
End With
Exit Sub
err1: MsgBox ("Error in cell " & lastcelladdr)
End Sub