Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
My vba knowledge is very limited. Appreciate it if someone can show me how to
do this programmatically: I have a master list of products which are grouped by Product Family ID. For each Product Family ID, I need to copy all products rows that belong to it from the master list into an Excel template and save it as a new workbook with the Product Family ID appended in the name. I also need the Prod. Family ID to appear in cell B2 of the Excel template. Sample of Master list structu ================================ ProductID | Product Name | Price per Unit | Product Family ID | Country Sample Excel Template: ====================== There are 3 worksheets in the template. 1st & 3rd worksheet just contains instructions & summary. The 2nd worksheet, "Product List", is the worksheet where I want to copy the data in from the master list. Product Family ID : ________ (cell B2) ProductID | Product Name | Price per Unit | Product Family ID | Country | Custom Calculation 1 | Custom Calculation 2 | Custom Calculation 3 | Formula 1 | Formula 2.... The Excel template contains macros and modules (the Custom calculation fields in the template are custom vba functions, and there's a bunch of other code under Worksheet_Change and in the "Product List" worksheet itself). In addition, for each new workbook created: 1) The worksheet in the Excel template where we copy the products into needs to be protected. 2) The vbaproject needs to be locked/protected too, to prevent others from viewing the code and determine how some calculations are derived. I'm desperate for help..... Manually copying and pasting to create 200 workbooks is tedious business :-( Thanks, Mikaela |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Mikaela: Can you record a macro of the manual steps you perform so we can
modify the learned macro? The new macro should automatically run some of your old macros as well as saving the files under different names. Review the recorded macro and make any commments to help modifiy the code. 1) on worksheet - Tools Menu - Macro - Record New Macro 2) Perform the steps you normally would for running your macro and saving the file. "Mikaela" wrote: My vba knowledge is very limited. Appreciate it if someone can show me how to do this programmatically: I have a master list of products which are grouped by Product Family ID. For each Product Family ID, I need to copy all products rows that belong to it from the master list into an Excel template and save it as a new workbook with the Product Family ID appended in the name. I also need the Prod. Family ID to appear in cell B2 of the Excel template. Sample of Master list structu ================================ ProductID | Product Name | Price per Unit | Product Family ID | Country Sample Excel Template: ====================== There are 3 worksheets in the template. 1st & 3rd worksheet just contains instructions & summary. The 2nd worksheet, "Product List", is the worksheet where I want to copy the data in from the master list. Product Family ID : ________ (cell B2) ProductID | Product Name | Price per Unit | Product Family ID | Country | Custom Calculation 1 | Custom Calculation 2 | Custom Calculation 3 | Formula 1 | Formula 2.... The Excel template contains macros and modules (the Custom calculation fields in the template are custom vba functions, and there's a bunch of other code under Worksheet_Change and in the "Product List" worksheet itself). In addition, for each new workbook created: 1) The worksheet in the Excel template where we copy the products into needs to be protected. 2) The vbaproject needs to be locked/protected too, to prevent others from viewing the code and determine how some calculations are derived. I'm desperate for help..... Manually copying and pasting to create 200 workbooks is tedious business :-( Thanks, Mikaela |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Hi Joel, Thanks for your reply. The samples I posted before were simplified examples so I could explain what I needed without confusing people too much.... As I'm recording the macro, I'm posting the actual thing he Master list of products - Master.xls Excel template - Template.xlt Step-by-step of the manual process: ========================== 1. Open "Master.xls". 2. Create new workbook from "template.xlt". Choose disable macros when opening. 3. In the new workbook, go to "Template" sheet: - Unprotect this sheet (Password is "12345678"). - Select AT23:BT23 & drag down till row 28. (AT23:BT23 is basically the data row with cells containing special formats, formulas, UDFs, etc. How many rows that needs to be created with the drag down depends on how many products there are with same ProductFamilyID (Column Z in "MasterList" sheet in Master.xls). In this example it is 6 rows) 4. Go to "MasterList" sheet in "Master.xls", select & copy A2:O7. In the new workbook, go to "Template" sheet & 'Paste Special - values' into A23:O28. 5. Go to "MasterList" sheet in "Master.xls", select & copy R2:Z7. In the new workbook, go to "Template" sheet & 'Paste Special - values' into BL23:BT28. Then HIDE columns BJ to BT. 5. Go to "footer" sheet in "Master.xls" & select & copy A1. In the new workbook, sheet "Template", paste into the first cell of the next row after the last data row. In this example, paste into A29. 6. In new workbook, sheet "Template", 'Paste Special - values' the ProductFamilyID into Cell E1. ProductFamilyID. ProductFamilyID is in Z column of "MasterList" sheet in "Master.xls". 7. Go to "amt tracking" sheet in "Master.xls". Column A is the ProductFamilyID and Columns B to D is are number values associated with it. For that ProductFamilyID (Column A) that is being worked on, I need to paste the corresponding values (Column B to D) into the new workbook "Template" sheet: - On "amt tracking" sheet in "Master.xls", select & copy B2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B9. - On "amt tracking" sheet in "Master.xls". select & copy C2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B10. -. On "amt tracking" sheet in "Master.xls", select & copy D2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B11. 8. There's some open groupings (i.e. plus & minus signs) in the columns in the template. Close the groupings in column Y, AG, AR, AX, BA, BE. 9. Protect the "Template" sheet (Password is "12345678"). 10. Create new folder for the workbook recipient (A recipient can be linked to more than one ProductFamilyID. The example here is "alanhudson"). Save workbook as "template_(ProductFamilyID)_(RecipientName).xl s" (example ProductFamilyID is ZA1112C3, recipient is "AlanHudson"). ProductFamilyID is located in "MasterList" sheet in "Master.xls" Z column (Z2 onwards), RecipientName in AA column (AA2 onwards). 11. Close the saved workbook. Recorded macro code: ================ Code for Macro recording: Sub Macro9() ' ' Macro9 Macro ' ' Workbooks.Add Template:="C:\MasterList\template.xlt" Cells.Select ActiveSheet.Unprotect Range("A23:BT23").Select ActiveWindow.SmallScroll Down:=9 Selection.AutoFill Destination:=Range("A23:BT28"), Type:=xlFillDefault Range("A23:BT28").Select ActiveWindow.LargeScroll ToRight:=-3 Windows("Master.xls").Activate Range("A2:O7").Select Selection.Copy Windows("template1").Activate Range("A23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Range("R2:Z7").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 19 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 22 ActiveWindow.ScrollColumn = 23 ActiveWindow.ScrollColumn = 24 ActiveWindow.ScrollColumn = 25 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 27 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 29 ActiveWindow.ScrollColumn = 30 ActiveWindow.ScrollColumn = 31 ActiveWindow.ScrollColumn = 32 ActiveWindow.ScrollColumn = 33 ActiveWindow.ScrollColumn = 34 ActiveWindow.ScrollColumn = 35 ActiveWindow.ScrollColumn = 36 ActiveWindow.ScrollColumn = 37 ActiveWindow.ScrollColumn = 38 ActiveWindow.ScrollColumn = 39 ActiveWindow.ScrollColumn = 40 ActiveWindow.ScrollColumn = 41 ActiveWindow.ScrollColumn = 42 ActiveWindow.ScrollColumn = 43 ActiveWindow.ScrollColumn = 44 ActiveWindow.ScrollColumn = 45 ActiveWindow.ScrollColumn = 46 ActiveWindow.ScrollColumn = 47 ActiveWindow.ScrollColumn = 48 ActiveWindow.ScrollColumn = 49 ActiveWindow.ScrollColumn = 50 ActiveWindow.ScrollColumn = 51 ActiveWindow.ScrollColumn = 52 ActiveWindow.ScrollColumn = 53 ActiveWindow.ScrollColumn = 54 ActiveWindow.ScrollColumn = 55 ActiveWindow.ScrollColumn = 56 ActiveWindow.ScrollColumn = 57 ActiveWindow.ScrollColumn = 58 ActiveWindow.ScrollColumn = 59 Range("BL23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.LargeScroll ToRight:=-3 ActiveWindow.SmallScroll Down:=3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 23 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 32 ActiveWindow.ScrollColumn = 37 ActiveWindow.ScrollColumn = 40 ActiveWindow.ScrollColumn = 41 ActiveWindow.ScrollColumn = 43 ActiveWindow.ScrollColumn = 48 ActiveWindow.ScrollColumn = 49 ActiveWindow.ScrollColumn = 48 ActiveWindow.ScrollColumn = 49 ActiveWindow.ScrollColumn = 50 ActiveWindow.ScrollColumn = 51 ActiveWindow.ScrollColumn = 52 ActiveWindow.ScrollColumn = 53 ActiveWindow.ScrollColumn = 54 ActiveWindow.ScrollColumn = 55 ActiveWindow.ScrollColumn = 56 ActiveWindow.ScrollColumn = 57 ActiveWindow.ScrollColumn = 55 ActiveWindow.ScrollColumn = 56 ActiveWindow.ScrollColumn = 57 Columns("BJ:BT").Select Range("BJ13").Activate Selection.EntireColumn.Hidden = True ActiveWindow.LargeScroll ToRight:=-3 Windows("Master.xls").Activate Sheets("footer").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("A29").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=-15 Windows("Master.xls").Activate Sheets("MasterList").Select Range("Z2").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("E3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Sheets("amt tracking").Select Range("B2").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("B9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Range("C2").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("B10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Range("D2").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("B11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 19 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 22 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 27 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 29 ActiveWindow.ScrollColumn = 30 ActiveWindow.ScrollColumn = 29 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 27 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 24 ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Cells.Select Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ChDir "C:\MasterList\alanhudson" ActiveWorkbook.SaveAs Filename:= _ "C:\MasterList\alanhudson\template_ZA1112C3_AlanHu dson.xls", FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False End Sub This is very long, but I really appreciate any help! Regards, Mikaela "Joel" wrote: Mikaela: Can you record a macro of the manual steps you perform so we can modify the learned macro? The new macro should automatically run some of your old macros as well as saving the files under different names. Review the recorded macro and make any commments to help modifiy the code. 1) on worksheet - Tools Menu - Macro - Record New Macro 2) Perform the steps you normally would for running your macro and saving the file. "Mikaela" wrote: My vba knowledge is very limited. Appreciate it if someone can show me how to do this programmatically: I have a master list of products which are grouped by Product Family ID. For each Product Family ID, I need to copy all products rows that belong to it from the master list into an Excel template and save it as a new workbook with the Product Family ID appended in the name. I also need the Prod. Family ID to appear in cell B2 of the Excel template. Sample of Master list structu ================================ ProductID | Product Name | Price per Unit | Product Family ID | Country Sample Excel Template: ====================== There are 3 worksheets in the template. 1st & 3rd worksheet just contains instructions & summary. The 2nd worksheet, "Product List", is the worksheet where I want to copy the data in from the master list. Product Family ID : ________ (cell B2) ProductID | Product Name | Price per Unit | Product Family ID | Country | Custom Calculation 1 | Custom Calculation 2 | Custom Calculation 3 | Formula 1 | Formula 2.... The Excel template contains macros and modules (the Custom calculation fields in the template are custom vba functions, and there's a bunch of other code under Worksheet_Change and in the "Product List" worksheet itself). In addition, for each new workbook created: 1) The worksheet in the Excel template where we copy the products into needs to be protected. 2) The vbaproject needs to be locked/protected too, to prevent others from viewing the code and determine how some calculations are derived. I'm desperate for help..... Manually copying and pasting to create 200 workbooks is tedious business :-( Thanks, Mikaela |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Try this code. Will not guarentee it will work the first try. there were
differences between your description and the macro and wasn't sure which was correct. Macro contains both a templete and templete1 worksheet. The code below use both templetes even though your description only had one. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_Count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_Count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") .Range("B2").Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C2").Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D2").Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False startrow = RowCount + 1 End If Next RowCount End With End Sub "Mikaela" wrote: Hi Joel, Thanks for your reply. The samples I posted before were simplified examples so I could explain what I needed without confusing people too much.... As I'm recording the macro, I'm posting the actual thing he Master list of products - Master.xls Excel template - Template.xlt Step-by-step of the manual process: ========================== 1. Open "Master.xls". 2. Create new workbook from "template.xlt". Choose disable macros when opening. 3. In the new workbook, go to "Template" sheet: - Unprotect this sheet (Password is "12345678"). - Select AT23:BT23 & drag down till row 28. (AT23:BT23 is basically the data row with cells containing special formats, formulas, UDFs, etc. How many rows that needs to be created with the drag down depends on how many products there are with same ProductFamilyID (Column Z in "MasterList" sheet in Master.xls). In this example it is 6 rows) 4. Go to "MasterList" sheet in "Master.xls", select & copy A2:O7. In the new workbook, go to "Template" sheet & 'Paste Special - values' into A23:O28. 5. Go to "MasterList" sheet in "Master.xls", select & copy R2:Z7. In the new workbook, go to "Template" sheet & 'Paste Special - values' into BL23:BT28. Then HIDE columns BJ to BT. 5. Go to "footer" sheet in "Master.xls" & select & copy A1. In the new workbook, sheet "Template", paste into the first cell of the next row after the last data row. In this example, paste into A29. 6. In new workbook, sheet "Template", 'Paste Special - values' the ProductFamilyID into Cell E1. ProductFamilyID. ProductFamilyID is in Z column of "MasterList" sheet in "Master.xls". 7. Go to "amt tracking" sheet in "Master.xls". Column A is the ProductFamilyID and Columns B to D is are number values associated with it. For that ProductFamilyID (Column A) that is being worked on, I need to paste the corresponding values (Column B to D) into the new workbook "Template" sheet: - On "amt tracking" sheet in "Master.xls", select & copy B2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B9. - On "amt tracking" sheet in "Master.xls". select & copy C2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B10. -. On "amt tracking" sheet in "Master.xls", select & copy D2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B11. 8. There's some open groupings (i.e. plus & minus signs) in the columns in the template. Close the groupings in column Y, AG, AR, AX, BA, BE. 9. Protect the "Template" sheet (Password is "12345678"). 10. Create new folder for the workbook recipient (A recipient can be linked to more than one ProductFamilyID. The example here is "alanhudson"). Save workbook as "template_(ProductFamilyID)_(RecipientName).xl s" (example ProductFamilyID is ZA1112C3, recipient is "AlanHudson"). ProductFamilyID is located in "MasterList" sheet in "Master.xls" Z column (Z2 onwards), RecipientName in AA column (AA2 onwards). 11. Close the saved workbook. Recorded macro code: ================ Code for Macro recording: Sub Macro9() ' ' Macro9 Macro ' ' Workbooks.Add Template:="C:\MasterList\template.xlt" Cells.Select ActiveSheet.Unprotect Range("A23:BT23").Select ActiveWindow.SmallScroll Down:=9 Selection.AutoFill Destination:=Range("A23:BT28"), Type:=xlFillDefault Range("A23:BT28").Select ActiveWindow.LargeScroll ToRight:=-3 Windows("Master.xls").Activate Range("A2:O7").Select Selection.Copy Windows("template1").Activate Range("A23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Range("R2:Z7").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 19 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 22 ActiveWindow.ScrollColumn = 23 ActiveWindow.ScrollColumn = 24 ActiveWindow.ScrollColumn = 25 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 27 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 29 ActiveWindow.ScrollColumn = 30 ActiveWindow.ScrollColumn = 31 ActiveWindow.ScrollColumn = 32 ActiveWindow.ScrollColumn = 33 ActiveWindow.ScrollColumn = 34 ActiveWindow.ScrollColumn = 35 ActiveWindow.ScrollColumn = 36 ActiveWindow.ScrollColumn = 37 ActiveWindow.ScrollColumn = 38 ActiveWindow.ScrollColumn = 39 ActiveWindow.ScrollColumn = 40 ActiveWindow.ScrollColumn = 41 ActiveWindow.ScrollColumn = 42 ActiveWindow.ScrollColumn = 43 ActiveWindow.ScrollColumn = 44 ActiveWindow.ScrollColumn = 45 ActiveWindow.ScrollColumn = 46 ActiveWindow.ScrollColumn = 47 ActiveWindow.ScrollColumn = 48 ActiveWindow.ScrollColumn = 49 ActiveWindow.ScrollColumn = 50 ActiveWindow.ScrollColumn = 51 ActiveWindow.ScrollColumn = 52 ActiveWindow.ScrollColumn = 53 ActiveWindow.ScrollColumn = 54 ActiveWindow.ScrollColumn = 55 ActiveWindow.ScrollColumn = 56 ActiveWindow.ScrollColumn = 57 ActiveWindow.ScrollColumn = 58 ActiveWindow.ScrollColumn = 59 Range("BL23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.LargeScroll ToRight:=-3 ActiveWindow.SmallScroll Down:=3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 23 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 32 ActiveWindow.ScrollColumn = 37 ActiveWindow.ScrollColumn = 40 ActiveWindow.ScrollColumn = 41 ActiveWindow.ScrollColumn = 43 ActiveWindow.ScrollColumn = 48 ActiveWindow.ScrollColumn = 49 ActiveWindow.ScrollColumn = 48 ActiveWindow.ScrollColumn = 49 ActiveWindow.ScrollColumn = 50 ActiveWindow.ScrollColumn = 51 ActiveWindow.ScrollColumn = 52 ActiveWindow.ScrollColumn = 53 ActiveWindow.ScrollColumn = 54 ActiveWindow.ScrollColumn = 55 ActiveWindow.ScrollColumn = 56 ActiveWindow.ScrollColumn = 57 ActiveWindow.ScrollColumn = 55 ActiveWindow.ScrollColumn = 56 ActiveWindow.ScrollColumn = 57 Columns("BJ:BT").Select Range("BJ13").Activate Selection.EntireColumn.Hidden = True ActiveWindow.LargeScroll ToRight:=-3 Windows("Master.xls").Activate Sheets("footer").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("A29").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=-15 Windows("Master.xls").Activate Sheets("MasterList").Select Range("Z2").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("E3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Sheets("amt tracking").Select Range("B2").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("B9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Range("C2").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("B10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Range("D2").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate Range("B11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 19 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 22 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 27 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 29 ActiveWindow.ScrollColumn = 30 ActiveWindow.ScrollColumn = 29 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 27 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 24 ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Cells.Select Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ChDir "C:\MasterList\alanhudson" ActiveWorkbook.SaveAs Filename:= _ "C:\MasterList\alanhudson\template_ZA1112C3_AlanHu dson.xls", FileFormat:= _ |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
I tested the code. It worked quite well & is VERY close to what I wanted to
do, except for a few parts (listed below). Am not sure I know why a template & template1 worksheet is needed (I'm new at this, pls bear with me). 1. The autofill of A23:BT23 in the template worksheet in the new Template workbook created from Template.xlt doesn't work for some reason. The format doesn't autofill down to the number of product rows needed. 2. When copying values from "amt tracking" sheet in Master.xls into B9, B10 & B11 in template worksheet, the values that need to be copied are in columns B, C & D *depending* on Product Family ID in column A. Example, if Product Family ID is "XYZ" located in A13, then B13, C13 & D13 in "amt tracking" sheet is copied into B9, B10 & B11 in the template worksheet. Sorry if my explanation wasn't clear enough in the past. Also, how do I modify the code so that: 1. In the template worksheet, after data is pasted from Master.xls (like in the code snippet below), if value of the cell in column D equals "Asia Pacific", then the corresponding cell in column E's unlocked & hidden property must be false, and the cell background changed color to yellow. ..Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True 2. After the new workbook is saved, the workbook will be closed. TIA NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy "Joel" wrote: Try this code. Will not guarentee it will work the first try. there were differences between your description and the macro and wasn't sure which was correct. Macro contains both a templete and templete1 worksheet. The code below use both templetes even though your description only had one. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_Count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_Count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") .Range("B2").Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C2").Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D2").Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False startrow = RowCount + 1 End If Next RowCount End With End Sub "Mikaela" wrote: Hi Joel, Thanks for your reply. The samples I posted before were simplified examples so I could explain what I needed without confusing people too much.... As I'm recording the macro, I'm posting the actual thing he Master list of products - Master.xls Excel template - Template.xlt Step-by-step of the manual process: ========================== 1. Open "Master.xls". 2. Create new workbook from "template.xlt". Choose disable macros when opening. 3. In the new workbook, go to "Template" sheet: - Unprotect this sheet (Password is "12345678"). - Select AT23:BT23 & drag down till row 28. (AT23:BT23 is basically the data row with cells containing special formats, formulas, UDFs, etc. How many rows that needs to be created with the drag down depends on how many products there are with same ProductFamilyID (Column Z in "MasterList" sheet in Master.xls). In this example it is 6 rows) 4. Go to "MasterList" sheet in "Master.xls", select & copy A2:O7. In the new workbook, go to "Template" sheet & 'Paste Special - values' into A23:O28. 5. Go to "MasterList" sheet in "Master.xls", select & copy R2:Z7. In the new workbook, go to "Template" sheet & 'Paste Special - values' into BL23:BT28. Then HIDE columns BJ to BT. 5. Go to "footer" sheet in "Master.xls" & select & copy A1. In the new workbook, sheet "Template", paste into the first cell of the next row after the last data row. In this example, paste into A29. 6. In new workbook, sheet "Template", 'Paste Special - values' the ProductFamilyID into Cell E1. ProductFamilyID. ProductFamilyID is in Z column of "MasterList" sheet in "Master.xls". 7. Go to "amt tracking" sheet in "Master.xls". Column A is the ProductFamilyID and Columns B to D is are number values associated with it. For that ProductFamilyID (Column A) that is being worked on, I need to paste the corresponding values (Column B to D) into the new workbook "Template" sheet: - On "amt tracking" sheet in "Master.xls", select & copy B2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B9. - On "amt tracking" sheet in "Master.xls". select & copy C2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B10. -. On "amt tracking" sheet in "Master.xls", select & copy D2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B11. 8. There's some open groupings (i.e. plus & minus signs) in the columns in the template. Close the groupings in column Y, AG, AR, AX, BA, BE. 9. Protect the "Template" sheet (Password is "12345678"). 10. Create new folder for the workbook recipient (A recipient can be linked to more than one ProductFamilyID. The example here is "alanhudson"). Save workbook as "template_(ProductFamilyID)_(RecipientName).xl s" (example ProductFamilyID is ZA1112C3, recipient is "AlanHudson"). ProductFamilyID is located in "MasterList" sheet in "Master.xls" Z column (Z2 onwards), RecipientName in AA column (AA2 onwards). 11. Close the saved workbook. Recorded macro code: ================ Code for Macro recording: Sub Macro9() ' ' Macro9 Macro ' ' Workbooks.Add Template:="C:\MasterList\template.xlt" Cells.Select ActiveSheet.Unprotect Range("A23:BT23").Select ActiveWindow.SmallScroll Down:=9 Selection.AutoFill Destination:=Range("A23:BT28"), Type:=xlFillDefault Range("A23:BT28").Select ActiveWindow.LargeScroll ToRight:=-3 Windows("Master.xls").Activate Range("A2:O7").Select Selection.Copy Windows("template1").Activate Range("A23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Range("R2:Z7").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 19 ActiveWindow.ScrollColumn = 20 ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 22 ActiveWindow.ScrollColumn = 23 ActiveWindow.ScrollColumn = 24 ActiveWindow.ScrollColumn = 25 ActiveWindow.ScrollColumn = 26 ActiveWindow.ScrollColumn = 27 ActiveWindow.ScrollColumn = 28 ActiveWindow.ScrollColumn = 29 ActiveWindow.ScrollColumn = 30 ActiveWindow.ScrollColumn = 31 ActiveWindow.ScrollColumn = 32 ActiveWindow.ScrollColumn = 33 ActiveWindow.ScrollColumn = 34 ActiveWindow.ScrollColumn = 35 ActiveWindow.ScrollColumn = 36 ActiveWindow.ScrollColumn = 37 ActiveWindow.ScrollColumn = 38 ActiveWindow.ScrollColumn = 39 ActiveWindow.ScrollColumn = 40 ActiveWindow.ScrollColumn = 41 ActiveWindow.ScrollColumn = 42 ActiveWindow.ScrollColumn = 43 ActiveWindow.ScrollColumn = 44 ActiveWindow.ScrollColumn = 45 ActiveWindow.ScrollColumn = 46 ActiveWindow.ScrollColumn = 47 ActiveWindow.ScrollColumn = 48 ActiveWindow.ScrollColumn = 49 ActiveWindow.ScrollColumn = 50 ActiveWindow.ScrollColumn = 51 ActiveWindow.ScrollColumn = 52 ActiveWindow.ScrollColumn = 53 ActiveWindow.ScrollColumn = 54 ActiveWindow.ScrollColumn = 55 ActiveWindow.ScrollColumn = 56 ActiveWindow.ScrollColumn = 57 ActiveWindow.ScrollColumn = 58 ActiveWindow.ScrollColumn = 59 Range("BL23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.LargeScroll ToRight:=-3 ActiveWindow.SmallScroll Down:=3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 11 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Try these changes. I think there was an error in statements like this
(23 + Prod_count - 1) I added "-1". Also putting this change into the auto fill should correct problem 1. You instruction about hidden the cell in column E cannot be done. Single cells can't be hidden, only rows or columns can be hidden. I unlocked the cell and changed the background color to yellow. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count - 1)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Mikaela" wrote: I tested the code. It worked quite well & is VERY close to what I wanted to do, except for a few parts (listed below). Am not sure I know why a template & template1 worksheet is needed (I'm new at this, pls bear with me). 1. The autofill of A23:BT23 in the template worksheet in the new Template workbook created from Template.xlt doesn't work for some reason. The format doesn't autofill down to the number of product rows needed. 2. When copying values from "amt tracking" sheet in Master.xls into B9, B10 & B11 in template worksheet, the values that need to be copied are in columns B, C & D *depending* on Product Family ID in column A. Example, if Product Family ID is "XYZ" located in A13, then B13, C13 & D13 in "amt tracking" sheet is copied into B9, B10 & B11 in the template worksheet. Sorry if my explanation wasn't clear enough in the past. Also, how do I modify the code so that: 1. In the template worksheet, after data is pasted from Master.xls (like in the code snippet below), if value of the cell in column D equals "Asia Pacific", then the corresponding cell in column E's unlocked & hidden property must be false, and the cell background changed color to yellow. .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True 2. After the new workbook is saved, the workbook will be closed. TIA NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy "Joel" wrote: Try this code. Will not guarentee it will work the first try. there were differences between your description and the macro and wasn't sure which was correct. Macro contains both a templete and templete1 worksheet. The code below use both templetes even though your description only had one. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_Count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_Count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") .Range("B2").Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C2").Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D2").Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False startrow = RowCount + 1 End If Next RowCount End With End Sub "Mikaela" wrote: Hi Joel, Thanks for your reply. The samples I posted before were simplified examples so I could explain what I needed without confusing people too much.... As I'm recording the macro, I'm posting the actual thing he Master list of products - Master.xls Excel template - Template.xlt Step-by-step of the manual process: ========================== 1. Open "Master.xls". 2. Create new workbook from "template.xlt". Choose disable macros when opening. 3. In the new workbook, go to "Template" sheet: - Unprotect this sheet (Password is "12345678"). - Select AT23:BT23 & drag down till row 28. (AT23:BT23 is basically the data row with cells containing special formats, formulas, UDFs, etc. How many rows that needs to be created with the drag down depends on how many products there are with same ProductFamilyID (Column Z in "MasterList" sheet in Master.xls). In this example it is 6 rows) 4. Go to "MasterList" sheet in "Master.xls", select & copy A2:O7. In the new workbook, go to "Template" sheet & 'Paste Special - values' into A23:O28. 5. Go to "MasterList" sheet in "Master.xls", select & copy R2:Z7. In the new workbook, go to "Template" sheet & 'Paste Special - values' into BL23:BT28. Then HIDE columns BJ to BT. 5. Go to "footer" sheet in "Master.xls" & select & copy A1. In the new workbook, sheet "Template", paste into the first cell of the next row after the last data row. In this example, paste into A29. 6. In new workbook, sheet "Template", 'Paste Special - values' the ProductFamilyID into Cell E1. ProductFamilyID. ProductFamilyID is in Z column of "MasterList" sheet in "Master.xls". 7. Go to "amt tracking" sheet in "Master.xls". Column A is the ProductFamilyID and Columns B to D is are number values associated with it. For that ProductFamilyID (Column A) that is being worked on, I need to paste the corresponding values (Column B to D) into the new workbook "Template" sheet: - On "amt tracking" sheet in "Master.xls", select & copy B2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B9. - On "amt tracking" sheet in "Master.xls". select & copy C2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B10. -. On "amt tracking" sheet in "Master.xls", select & copy D2. Go to new workbook, sheet "Template", and 'Paste Special - values' into B11. 8. There's some open groupings (i.e. plus & minus signs) in the columns in the template. Close the groupings in column Y, AG, AR, AX, BA, BE. 9. Protect the "Template" sheet (Password is "12345678"). 10. Create new folder for the workbook recipient (A recipient can be linked to more than one ProductFamilyID. The example here is "alanhudson"). Save workbook as "template_(ProductFamilyID)_(RecipientName).xl s" (example ProductFamilyID is ZA1112C3, recipient is "AlanHudson"). ProductFamilyID is located in "MasterList" sheet in "Master.xls" Z column (Z2 onwards), RecipientName in AA column (AA2 onwards). 11. Close the saved workbook. Recorded macro code: ================ Code for Macro recording: Sub Macro9() ' ' Macro9 Macro ' ' Workbooks.Add Template:="C:\MasterList\template.xlt" Cells.Select ActiveSheet.Unprotect Range("A23:BT23").Select ActiveWindow.SmallScroll Down:=9 Selection.AutoFill Destination:=Range("A23:BT28"), Type:=xlFillDefault Range("A23:BT28").Select ActiveWindow.LargeScroll ToRight:=-3 Windows("Master.xls").Activate Range("A2:O7").Select Selection.Copy Windows("template1").Activate Range("A23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("Master.xls").Activate Range("R2:Z7").Select Application.CutCopyMode = False Selection.Copy Windows("template1").Activate ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
I tested the code. Received an error and the execution stops midway, on the
error msgbox it just states "400" ? Also, I was curious whether the autofill was working so I substituted your code Range("A23:BT" & (23 + Prod_count - 1) in this part : .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault with a fixed range i.e. Range("A23:BT24"). The autofill doesn't work even if the range is defined explicitly..... it doesn't autofill down. TIA "Joel" wrote: Try these changes. I think there was an error in statements like this (23 + Prod_count - 1) I added "-1". Also putting this change into the auto fill should correct problem 1. You instruction about hidden the cell in column E cannot be done. Single cells can't be hidden, only rows or columns can be hidden. I unlocked the cell and changed the background color to yellow. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count - 1)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Mikaela" wrote: I tested the code. It worked quite well & is VERY close to what I wanted to do, except for a few parts (listed below). Am not sure I know why a template & template1 worksheet is needed (I'm new at this, pls bear with me). 1. The autofill of A23:BT23 in the template worksheet in the new Template workbook created from Template.xlt doesn't work for some reason. The format doesn't autofill down to the number of product rows needed. 2. When copying values from "amt tracking" sheet in Master.xls into B9, B10 & B11 in template worksheet, the values that need to be copied are in columns B, C & D *depending* on Product Family ID in column A. Example, if Product Family ID is "XYZ" located in A13, then B13, C13 & D13 in "amt tracking" sheet is copied into B9, B10 & B11 in the template worksheet. Sorry if my explanation wasn't clear enough in the past. Also, how do I modify the code so that: 1. In the template worksheet, after data is pasted from Master.xls (like in the code snippet below), if value of the cell in column D equals "Asia Pacific", then the corresponding cell in column E's unlocked & hidden property must be false, and the cell background changed color to yellow. .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True 2. After the new workbook is saved, the workbook will be closed. TIA NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy "Joel" wrote: Try this code. Will not guarentee it will work the first try. there were differences between your description and the macro and wasn't sure which was correct. Macro contains both a templete and templete1 worksheet. The code below use both templetes even though your description only had one. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_Count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_Count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") .Range("B2").Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C2").Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D2").Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
I fixed the autofill. It was running the fill on the Master workbook instead
of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the problem. You can add variabbles into the watch window by highlighting the variable and then right click the mouse. Then select add to watch. I need more information to help fix this problem. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count - 1)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Mikaela" wrote: I tested the code. Received an error and the execution stops midway, on the error msgbox it just states "400" ? Also, I was curious whether the autofill was working so I substituted your code Range("A23:BT" & (23 + Prod_count - 1) in this part : .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault with a fixed range i.e. Range("A23:BT24"). The autofill doesn't work even if the range is defined explicitly..... it doesn't autofill down. TIA "Joel" wrote: Try these changes. I think there was an error in statements like this (23 + Prod_count - 1) I added "-1". Also putting this change into the auto fill should correct problem 1. You instruction about hidden the cell in column E cannot be done. Single cells can't be hidden, only rows or columns can be hidden. I unlocked the cell and changed the background color to yellow. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count - 1)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Mikaela" wrote: I tested the code. It worked quite well & is VERY close to what I wanted to do, except for a few parts (listed below). Am not sure I know why a template & template1 worksheet is needed (I'm new at this, pls bear with me). 1. The autofill of A23:BT23 in the template worksheet in the new Template workbook created from Template.xlt doesn't work for some reason. The format doesn't autofill down to the number of product rows needed. 2. When copying values from "amt tracking" sheet in Master.xls into B9, B10 & B11 in template worksheet, the values that need to be copied are in columns B, C & D *depending* on Product Family ID in column A. Example, if Product Family ID is "XYZ" located in A13, then B13, C13 & D13 in "amt tracking" sheet is copied into B9, B10 & B11 in the template worksheet. Sorry if my explanation wasn't clear enough in the past. Also, how do I modify the code so that: 1. In the template worksheet, after data is pasted from Master.xls (like in the code snippet below), if value of the cell in column D equals "Asia Pacific", then the corresponding cell in column E's unlocked & hidden property must be false, and the cell background changed color to yellow. .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True 2. After the new workbook is saved, the workbook will be closed. TIA NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy "Joel" wrote: Try this code. Will not guarentee it will work the first try. there were differences between your description and the macro and wasn't sure which was correct. Macro contains both a templete and templete1 worksheet. The code below use both templetes even though your description only had one. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_Count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + startrow - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_Count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") .Range("B2").Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C2").Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Thanks for your quick reply. I used F8 to step thru the code and found that
this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ ..Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault ..Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount ..Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) ..Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) ..Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ..Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ..Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Joel" wrote: I fixed the autofill. It was running the fill on the Master workbook instead of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the problem. You can add variabbles into the watch window by highlighting the variable and then right click the mouse. Then select add to watch. I need more information to help fix this problem. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count - 1)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Mikaela" wrote: I tested the code. Received an error and the execution stops midway, on the error msgbox it just states "400" ? Also, I was curious whether the autofill was working so I substituted your code Range("A23:BT" & (23 + Prod_count - 1) in this part : .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault with a fixed range i.e. Range("A23:BT24"). The autofill doesn't work even if the range is defined explicitly..... it doesn't autofill down. TIA "Joel" wrote: Try these changes. I think there was an error in statements like this (23 + Prod_count - 1) I added "-1". Also putting this change into the auto fill should correct problem 1. You instruction about hidden the cell in column E cannot be done. Single cells can't be hidden, only rows or columns can be hidden. I unlocked the cell and changed the background color to yellow. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Select NewTempl.Unprotect ("12345678") .Activate .Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count - 1)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
There is one place in the code where "23 + Prod_count " needs to be changed to
"23 + Prod_count - 1"). When it fails check the value of Prod_count. Your code uses 5 (23 + 5 - 1 = 27). The problem could be that my code is calculating a different value for Prod_count. The protection problem should be solved by unprotecting all features when the code is run. Then at the end of the code protect only some of the features. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True "Mikaela" wrote: Thanks for your quick reply. I used F8 to step thru the code and found that this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Joel" wrote: I fixed the autofill. It was running the fill on the Master workbook instead of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the problem. You can add variabbles into the watch window by highlighting the variable and then right click the mouse. Then select add to watch. I need more information to help fix this problem. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count - 1)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl.Unprotect ("12345678") recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
If you're referring to this part of the code,
ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) I changed the code to be like that because the "footer" value needs to appear on the *next* line after the last product row. Example: 23 + 4 product rows is A27. The product rows will occupy up to A26 while the "footer" value will be on A27. In the code that I used (23 + 5 - 1 = 27), 5 is a constant value chosen at random to temporarily substitute your autofill code that wasn't working. In my master list the number of products is arbitrary. Your code is the one I need because it counts the number of products per Product Family ID. I don't think there's a no difference between your Prod_count & my Prod_count..... I've checked by putting in a msgbox to prompt the value of "A23:BT" & (23 + Prod_count - 1). Example: 23 + 4 product rows - 1 = "A23:BT26". If the cause of the error can't be determined & fixed, is it possible to do some kind of workaround ? At worst, I can fill column AB in the Masterlist sheet with the number of product rows for each Product Family ID and let the code read the Prod_count from there (Similar to how the code reads the Recipients from column AA). I tried the protection code but am receiving this error "Compile Error. Expected: Named parameter". TIA "Joel" wrote: There is one place in the code where "23 + Prod_count " needs to be changed to "23 + Prod_count - 1"). When it fails check the value of Prod_count. Your code uses 5 (23 + 5 - 1 = 27). The problem could be that my code is calculating a different value for Prod_count. The protection problem should be solved by unprotecting all features when the code is run. Then at the end of the code protect only some of the features. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True "Mikaela" wrote: Thanks for your quick reply. I used F8 to step thru the code and found that this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Joel" wrote: I fixed the autofill. It was running the fill on the Master workbook instead of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the problem. You can add variabbles into the watch window by highlighting the variable and then right click the mouse. Then select add to watch. I need more information to help fix this problem. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count - 1)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Sorry, I meant "I don't think there's a difference between your Prod_count &
my Prod_count" Thx "Mikaela" wrote: If you're referring to this part of the code, ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) I changed the code to be like that because the "footer" value needs to appear on the *next* line after the last product row. Example: 23 + 4 product rows is A27. The product rows will occupy up to A26 while the "footer" value will be on A27. In the code that I used (23 + 5 - 1 = 27), 5 is a constant value chosen at random to temporarily substitute your autofill code that wasn't working. In my master list the number of products is arbitrary. Your code is the one I need because it counts the number of products per Product Family ID. I don't think there's a no difference between your Prod_count & my Prod_count..... I've checked by putting in a msgbox to prompt the value of "A23:BT" & (23 + Prod_count - 1). Example: 23 + 4 product rows - 1 = "A23:BT26". If the cause of the error can't be determined & fixed, is it possible to do some kind of workaround ? At worst, I can fill column AB in the Masterlist sheet with the number of product rows for each Product Family ID and let the code read the Prod_count from there (Similar to how the code reads the Recipients from column AA). I tried the protection code but am receiving this error "Compile Error. Expected: Named parameter". TIA "Joel" wrote: There is one place in the code where "23 + Prod_count " needs to be changed to "23 + Prod_count - 1"). When it fails check the value of Prod_count. Your code uses 5 (23 + 5 - 1 = 27). The problem could be that my code is calculating a different value for Prod_count. The protection problem should be solved by unprotecting all features when the code is run. Then at the end of the code protect only some of the features. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True "Mikaela" wrote: Thanks for your quick reply. I used F8 to step thru the code and found that this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Joel" wrote: I fixed the autofill. It was running the fill on the Master workbook instead of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the problem. You can add variabbles into the watch window by highlighting the variable and then right click the mouse. Then select add to watch. I need more information to help fix this problem. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Protect only has these methods. Not sure which one alows outlining.
expression.Protect(Password, DrawingObjects, Contents, Scenarios, UserInterfaceOnly, AllowFormattingCells, AllowFormattingColumns, AllowFormattingRows, AllowInsertingColumns, AllowInsertingRows, AllowInsertingHyperlinks, AllowDeletingColumns, AllowDeletingRows, AllowSorting, AllowFiltering, AllowUsingPivotTables) Try one more time the fixed code I gave you (see below) NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault I don't believe that changing just the range in the above code makes a differences in the code wroking and not working NewTempl.Range("A23:BT27"), _ "Mikaela" wrote: If you're referring to this part of the code, ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) I changed the code to be like that because the "footer" value needs to appear on the *next* line after the last product row. Example: 23 + 4 product rows is A27. The product rows will occupy up to A26 while the "footer" value will be on A27. In the code that I used (23 + 5 - 1 = 27), 5 is a constant value chosen at random to temporarily substitute your autofill code that wasn't working. In my master list the number of products is arbitrary. Your code is the one I need because it counts the number of products per Product Family ID. I don't think there's a no difference between your Prod_count & my Prod_count..... I've checked by putting in a msgbox to prompt the value of "A23:BT" & (23 + Prod_count - 1). Example: 23 + 4 product rows - 1 = "A23:BT26". If the cause of the error can't be determined & fixed, is it possible to do some kind of workaround ? At worst, I can fill column AB in the Masterlist sheet with the number of product rows for each Product Family ID and let the code read the Prod_count from there (Similar to how the code reads the Recipients from column AA). I tried the protection code but am receiving this error "Compile Error. Expected: Named parameter". TIA "Joel" wrote: There is one place in the code where "23 + Prod_count " needs to be changed to "23 + Prod_count - 1"). When it fails check the value of Prod_count. Your code uses 5 (23 + 5 - 1 = 27). The problem could be that my code is calculating a different value for Prod_count. The protection problem should be solved by unprotecting all features when the code is run. Then at the end of the code protect only some of the features. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True "Mikaela" wrote: Thanks for your quick reply. I used F8 to step thru the code and found that this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Joel" wrote: I fixed the autofill. It was running the fill on the Master workbook instead of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the problem. You can add variabbles into the watch window by highlighting the variable and then right click the mouse. Then select add to watch. I need more information to help fix this problem. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("D" & RCount) = "Asia Pacific" Then Range("E" & RCount).Locked = False Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
I agree with you. I tried it again, but the results are strangely the same :-(
I'm not sure if EnableOutlining is a method. But I have an example of it working. There's a macro in Template.xlt with EnableOutlining already working & it will allow a user to group & ungroup columns in the template sheet (PRODUCT TEMPLATE) while the sheet is protected : Private Sub Workbook_open() With Worksheets("PRODUCT TEMPLATE") .Protect Password:="12345678", userinterfaceonly:=True .EnableOutlining = True End With End Sub The above macro doesn't work in the new workbooks created with Macro 9 even tho' the macro exists in the new workbooks. Maybe because in Macro 9 macro we specified the new workbook's protection using NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True I just don't know how to incorporate into Macro 9 so that all the new workbooks will have the behavior of allowing the protected template sheet to group/ungroup TIA "Joel" wrote: Protect only has these methods. Not sure which one alows outlining. expression.Protect(Password, DrawingObjects, Contents, Scenarios, UserInterfaceOnly, AllowFormattingCells, AllowFormattingColumns, AllowFormattingRows, AllowInsertingColumns, AllowInsertingRows, AllowInsertingHyperlinks, AllowDeletingColumns, AllowDeletingRows, AllowSorting, AllowFiltering, AllowUsingPivotTables) Try one more time the fixed code I gave you (see below) NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault I don't believe that changing just the range in the above code makes a differences in the code wroking and not working NewTempl.Range("A23:BT27"), _ "Mikaela" wrote: If you're referring to this part of the code, ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) I changed the code to be like that because the "footer" value needs to appear on the *next* line after the last product row. Example: 23 + 4 product rows is A27. The product rows will occupy up to A26 while the "footer" value will be on A27. In the code that I used (23 + 5 - 1 = 27), 5 is a constant value chosen at random to temporarily substitute your autofill code that wasn't working. In my master list the number of products is arbitrary. Your code is the one I need because it counts the number of products per Product Family ID. I don't think there's a no difference between your Prod_count & my Prod_count..... I've checked by putting in a msgbox to prompt the value of "A23:BT" & (23 + Prod_count - 1). Example: 23 + 4 product rows - 1 = "A23:BT26". If the cause of the error can't be determined & fixed, is it possible to do some kind of workaround ? At worst, I can fill column AB in the Masterlist sheet with the number of product rows for each Product Family ID and let the code read the Prod_count from there (Similar to how the code reads the Recipients from column AA). I tried the protection code but am receiving this error "Compile Error. Expected: Named parameter". TIA "Joel" wrote: There is one place in the code where "23 + Prod_count " needs to be changed to "23 + Prod_count - 1"). When it fails check the value of Prod_count. Your code uses 5 (23 + 5 - 1 = 27). The problem could be that my code is calculating a different value for Prod_count. The protection problem should be solved by unprotecting all features when the code is run. Then at the end of the code protect only some of the features. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True "Mikaela" wrote: Thanks for your quick reply. I used F8 to step thru the code and found that this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Joel" wrote: I fixed the autofill. It was running the fill on the Master workbook instead of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the problem. You can add variabbles into the watch window by highlighting the variable and then right click the mouse. Then select add to watch. I need more information to help fix this problem. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Is it failing the first time through the loop, or is it failing on a later
loop? "Joel" wrote: Protect only has these methods. Not sure which one alows outlining. expression.Protect(Password, DrawingObjects, Contents, Scenarios, UserInterfaceOnly, AllowFormattingCells, AllowFormattingColumns, AllowFormattingRows, AllowInsertingColumns, AllowInsertingRows, AllowInsertingHyperlinks, AllowDeletingColumns, AllowDeletingRows, AllowSorting, AllowFiltering, AllowUsingPivotTables) Try one more time the fixed code I gave you (see below) NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault I don't believe that changing just the range in the above code makes a differences in the code wroking and not working NewTempl.Range("A23:BT27"), _ "Mikaela" wrote: If you're referring to this part of the code, ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) I changed the code to be like that because the "footer" value needs to appear on the *next* line after the last product row. Example: 23 + 4 product rows is A27. The product rows will occupy up to A26 while the "footer" value will be on A27. In the code that I used (23 + 5 - 1 = 27), 5 is a constant value chosen at random to temporarily substitute your autofill code that wasn't working. In my master list the number of products is arbitrary. Your code is the one I need because it counts the number of products per Product Family ID. I don't think there's a no difference between your Prod_count & my Prod_count..... I've checked by putting in a msgbox to prompt the value of "A23:BT" & (23 + Prod_count - 1). Example: 23 + 4 product rows - 1 = "A23:BT26". If the cause of the error can't be determined & fixed, is it possible to do some kind of workaround ? At worst, I can fill column AB in the Masterlist sheet with the number of product rows for each Product Family ID and let the code read the Prod_count from there (Similar to how the code reads the Recipients from column AA). I tried the protection code but am receiving this error "Compile Error. Expected: Named parameter". TIA "Joel" wrote: There is one place in the code where "23 + Prod_count " needs to be changed to "23 + Prod_count - 1"). When it fails check the value of Prod_count. Your code uses 5 (23 + 5 - 1 = 27). The problem could be that my code is calculating a different value for Prod_count. The protection problem should be solved by unprotecting all features when the code is run. Then at the end of the code protect only some of the features. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True "Mikaela" wrote: Thanks for your quick reply. I used F8 to step thru the code and found that this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Joel" wrote: I fixed the autofill. It was running the fill on the Master workbook instead of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the problem. You can add variabbles into the watch window by highlighting the variable and then right click the mouse. Then select add to watch. I need more information to help fix this problem. Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("Template") Set NewTempl1 = NewBook.Sheets("Template1") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select |
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
First time thru the loop.
|
#17
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Enable outlining is not a protection method. It is its own method.
from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl1.EnableOutlining = True The only thing I can think of to fix the auto fill is the following: FillRange = "A23:BT" & (23 + Prod_count - 1) NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range(FillRange), _ Type:=xlFillDefault "Mikaela" wrote: I agree with you. I tried it again, but the results are strangely the same :-( I'm not sure if EnableOutlining is a method. But I have an example of it working. There's a macro in Template.xlt with EnableOutlining already working & it will allow a user to group & ungroup columns in the template sheet (PRODUCT TEMPLATE) while the sheet is protected : Private Sub Workbook_open() With Worksheets("PRODUCT TEMPLATE") .Protect Password:="12345678", userinterfaceonly:=True .EnableOutlining = True End With End Sub The above macro doesn't work in the new workbooks created with Macro 9 even tho' the macro exists in the new workbooks. Maybe because in Macro 9 macro we specified the new workbook's protection using NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True I just don't know how to incorporate into Macro 9 so that all the new workbooks will have the behavior of allowing the protected template sheet to group/ungroup TIA "Joel" wrote: Protect only has these methods. Not sure which one alows outlining. expression.Protect(Password, DrawingObjects, Contents, Scenarios, UserInterfaceOnly, AllowFormattingCells, AllowFormattingColumns, AllowFormattingRows, AllowInsertingColumns, AllowInsertingRows, AllowInsertingHyperlinks, AllowDeletingColumns, AllowDeletingRows, AllowSorting, AllowFiltering, AllowUsingPivotTables) Try one more time the fixed code I gave you (see below) NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault I don't believe that changing just the range in the above code makes a differences in the code wroking and not working NewTempl.Range("A23:BT27"), _ "Mikaela" wrote: If you're referring to this part of the code, ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) I changed the code to be like that because the "footer" value needs to appear on the *next* line after the last product row. Example: 23 + 4 product rows is A27. The product rows will occupy up to A26 while the "footer" value will be on A27. In the code that I used (23 + 5 - 1 = 27), 5 is a constant value chosen at random to temporarily substitute your autofill code that wasn't working. In my master list the number of products is arbitrary. Your code is the one I need because it counts the number of products per Product Family ID. I don't think there's a no difference between your Prod_count & my Prod_count..... I've checked by putting in a msgbox to prompt the value of "A23:BT" & (23 + Prod_count - 1). Example: 23 + 4 product rows - 1 = "A23:BT26". If the cause of the error can't be determined & fixed, is it possible to do some kind of workaround ? At worst, I can fill column AB in the Masterlist sheet with the number of product rows for each Product Family ID and let the code read the Prod_count from there (Similar to how the code reads the Recipients from column AA). I tried the protection code but am receiving this error "Compile Error. Expected: Named parameter". TIA "Joel" wrote: There is one place in the code where "23 + Prod_count " needs to be changed to "23 + Prod_count - 1"). When it fails check the value of Prod_count. Your code uses 5 (23 + 5 - 1 = 27). The problem could be that my code is calculating a different value for Prod_count. The protection problem should be solved by unprotecting all features when the code is run. Then at the end of the code protect only some of the features. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True "Mikaela" wrote: Thanks for your quick reply. I used F8 to step thru the code and found that this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If Next file If found = False Then mysubfolder.Add (recipient) End If NewBook.SaveAs Filename:= _ Path & recipient & "\template_" & _ Prod_ID & "_" & _ recipient & ".xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False NewBook.Close startrow = RowCount + 1 End If Next RowCount End With End Sub "Joel" wrote: I fixed the autofill. It was running the fill on the Master workbook instead of the Templet. I wasn't able to repeat the 400 error. Can you specifiy which line of code created the error. the error line should be highlighted in yellow. You may have to step through the code using the F8 key to help find the |
#18
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
I tried your latest autofill code and the results are still the same... it's
not working. (At this point, I wouldn't mind if I had to settle with a workaround.) For your enable.outlining code, to test it I had to temporarily use this back : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault But when I applied this & ran the macro: NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl1.EnableOutlining = True I get an error stating "Runtime error 1004. Application-defined or object-defined error"...... I have to say I'm sorry for this frustrating problems..... "Joel" wrote: Enable outlining is not a protection method. It is its own method. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True NewTempl1.EnableOutlining = True The only thing I can think of to fix the auto fill is the following: FillRange = "A23:BT" & (23 + Prod_count - 1) NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range(FillRange), _ Type:=xlFillDefault "Mikaela" wrote: I agree with you. I tried it again, but the results are strangely the same :-( I'm not sure if EnableOutlining is a method. But I have an example of it working. There's a macro in Template.xlt with EnableOutlining already working & it will allow a user to group & ungroup columns in the template sheet (PRODUCT TEMPLATE) while the sheet is protected : Private Sub Workbook_open() With Worksheets("PRODUCT TEMPLATE") .Protect Password:="12345678", userinterfaceonly:=True .EnableOutlining = True End With End Sub The above macro doesn't work in the new workbooks created with Macro 9 even tho' the macro exists in the new workbooks. Maybe because in Macro 9 macro we specified the new workbook's protection using NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True I just don't know how to incorporate into Macro 9 so that all the new workbooks will have the behavior of allowing the protected template sheet to group/ungroup TIA "Joel" wrote: Protect only has these methods. Not sure which one alows outlining. expression.Protect(Password, DrawingObjects, Contents, Scenarios, UserInterfaceOnly, AllowFormattingCells, AllowFormattingColumns, AllowFormattingRows, AllowInsertingColumns, AllowInsertingRows, AllowInsertingHyperlinks, AllowDeletingColumns, AllowDeletingRows, AllowSorting, AllowFiltering, AllowUsingPivotTables) Try one more time the fixed code I gave you (see below) NewTempl.Range("A23:BT23").Select Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault I don't believe that changing just the range in the above code makes a differences in the code wroking and not working NewTempl.Range("A23:BT27"), _ "Mikaela" wrote: If you're referring to this part of the code, ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) I changed the code to be like that because the "footer" value needs to appear on the *next* line after the last product row. Example: 23 + 4 product rows is A27. The product rows will occupy up to A26 while the "footer" value will be on A27. In the code that I used (23 + 5 - 1 = 27), 5 is a constant value chosen at random to temporarily substitute your autofill code that wasn't working. In my master list the number of products is arbitrary. Your code is the one I need because it counts the number of products per Product Family ID. I don't think there's a no difference between your Prod_count & my Prod_count..... I've checked by putting in a msgbox to prompt the value of "A23:BT" & (23 + Prod_count - 1). Example: 23 + 4 product rows - 1 = "A23:BT26". If the cause of the error can't be determined & fixed, is it possible to do some kind of workaround ? At worst, I can fill column AB in the Masterlist sheet with the number of product rows for each Product Family ID and let the code read the Prod_count from there (Similar to how the code reads the Recipients from column AA). I tried the protection code but am receiving this error "Compile Error. Expected: Named parameter". TIA "Joel" wrote: There is one place in the code where "23 + Prod_count " needs to be changed to "23 + Prod_count - 1"). When it fails check the value of Prod_count. Your code uses 5 (23 + 5 - 1 = 27). The problem could be that my code is calculating a different value for Prod_count. The protection problem should be solved by unprotecting all features when the code is run. Then at the end of the code protect only some of the features. from NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True to NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ EnableOutlining = True "Mikaela" wrote: Thanks for your quick reply. I used F8 to step thru the code and found that this part caused the error is : Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault It throws out this error msgbox "Run-time error '1004'. Application-defined or object-defined error". I added NewTempl & Product_count to the watch window. In the watch window, the moment it reaches that part of code the values in these variables turn to "<Out of context". When an explicitly defined range like "A23:BT27" is used, the autofill works... most of the time. I'm not sure why it wouldn't work all the time (I'm making a wild guess that Excel is confused with the selection since more than one workbook is being handled :P) As you can't reproduce the error, I wonder whether I did something on my side. When you post your code I tweak it a teeny bit to suit me 100% (the code that works for me is below verbatim). Also, a few days ago I changed the name of the template sheet in the "Template.xlt" file from "Template" to "PRODUCT TEMPLATE" and I also changed the code to cater to this. I wonder if this modification is preventing the autofill from working..... One last request... I need to change the protection properties to enable outlining to work in the protected template sheet. I.e. something like this: NewTempl.Protect Password:="12345678", userinterfaceonly:=True NewTempl.EnableOutlining = True If I use the above code, it throws an error at the autofill part of the code (I was using explicitly defined range for the autofill while I was testing this). Appreciate your help. TIA ============================= Sub Macro9() ' ' Macro9 Macro ' Set fs = CreateObject("Scripting.FileSystemObject") ' With ThisWorkbook.Sheets("MasterList") LastRow = .Cells(Rows.Count, "Z").End(xlUp).Row 'Start Row is 1st row of a Product ID startrow = 2 For RowCount = 2 To LastRow If .Cells(RowCount, "Z") < _ .Cells(RowCount + 1, "Z") Then Prod_ID = .Cells(RowCount, "Z") Prod_count = RowCount - startrow + 1 Workbooks.Add _ Template:="C:\MasterList\template.xlt" Set NewBook = ActiveWorkbook Set NewTempl = NewBook.Sheets("PRODUCT TEMPLATE") Set NewTempl1 = NewBook.Sheets("PRODUCT TEMPLATE") NewTempl.Activate NewTempl.Unprotect ("12345678") NewTempl.Range("A23:BT23").Select 'Commenting out because this part throws an error 'Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT" & (23 + Prod_count - 1)), _ Type:=xlFillDefault 'In order to test entire macro, using explicit-defined range for autofill Selection.AutoFill _ Destination:= _ NewTempl.Range("A23:BT27"), Type:=xlFillDefault .Range("A" & startrow & ":O" & RowCount).Copy NewTempl.Range("A23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False ' check for "Asia Pacific" For RCount = 23 To (23 + Prod_count - 1) If NewTempl.Range("C" & RCount) = "Asia Pacific" Then NewTempl.Range("E" & RCount).Locked = False NewTempl.Range("E" & RCount).Interior.ColorIndex = 6 End If Next RCount .Range("R" & startrow & ":Z" & RowCount).Copy NewTempl1.Range("BL23").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False NewTempl1.Columns("BJ:BT"). _ EntireColumn.Hidden = True ThisWorkbook.Sheets("footer"). _ Range("A1").Copy _ Destination:= _ NewTempl1.Range("A" & (23 + Prod_count)) .Range("Z" & RowCount).Copy NewTempl1.Range("E3").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False With ThisWorkbook.Sheets("amt tracking") 'Find Prod_ID Set c = .Columns("A:A").Find(what:=Prod_ID, LookIn:=xlValues) .Range("B" & c.Row).Copy NewTempl1.Range("B9").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("C" & c.Row).Copy NewTempl1.Range("B10").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Range("D" & c.Row).Copy NewTempl1.Range("B11").PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False End With NewTempl1.Protect "12345678", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True recipient = .Range("AA" & RowCount) Path = "C:\MasterList\" Set folder = _ fs.GetFolder(Path) Set mysubfolder = folder.subfolders found = False For Each file In mysubfolder If file.Name = recipient Then found = True Exit For End If |
#19
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
If you are still getting an error try this code to help isolate the problem.
It may be related to data on the templet. This code loops through the columms A23:BT23 and tries to find which column data is causing the error 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).Select Selection.AutoFill _ Destination:= _ NewTempl.Range(ToRange), _ Type:=xlFillDefault Next Colcount End With Exit Sub err1: MsgBox ("Error in cell " & lastcelladdr) End Sub "Mikaela" wrote: First time thru the loop. |
#20
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
Have run this and these are the results:
1st try - the msgbox pops up stating "Error in cell ". (strangely there was no cell address appended to the msg). 2nd try - received this error "Run-time error '1004'. Application-defined or object-defined error". The autofill ceases to run at column Q. 3rd try and onwards the code ran smoothly without any problem. The inconsistency of the results is very peculiar as I didn't modify the code in between any of the tries..... "Joel" wrote: If you are still getting an error try this code to help isolate the problem. It may be related to data on the templet. This code loops through the columms A23:BT23 and tries to find which column data is causing the error 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).Select Selection.AutoFill _ Destination:= _ NewTempl.Range(ToRange), _ Type:=xlFillDefault Next Colcount End With Exit Sub err1: MsgBox ("Error in cell " & lastcelladdr) End Sub "Mikaela" wrote: First time thru the loop. |
#21
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
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. "Mikaela" wrote: Have run this and these are the results: 1st try - the msgbox pops up stating "Error in cell ". (strangely there was no cell address appended to the msg). 2nd try - received this error "Run-time error '1004'. Application-defined or object-defined error". The autofill ceases to run at column Q. 3rd try and onwards the code ran smoothly without any problem. The inconsistency of the results is very peculiar as I didn't modify the code in between any of the tries..... "Joel" wrote: If you are still getting an error try this code to help isolate the problem. It may be related to data on the templet. This code loops through the columms A23:BT23 and tries to find which column data is causing the error 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).Select Selection.AutoFill _ Destination:= _ NewTempl.Range(ToRange), _ Type:=xlFillDefault Next Colcount End With Exit Sub err1: MsgBox ("Error in cell " & lastcelladdr) End Sub "Mikaela" wrote: First time thru the loop. |
#22
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
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: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 "Joel" wrote: 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. "Mikaela" wrote: Have run this and these are the results: 1st try - the msgbox pops up stating "Error in cell ". (strangely there was no cell address appended to the msg). 2nd try - received this error "Run-time error '1004'. Application-defined or object-defined error". The autofill ceases to run at column Q. 3rd try and onwards the code ran smoothly without any problem. The inconsistency of the results is very peculiar as I didn't modify the code in between any of the tries..... "Joel" wrote: If you are still getting an error try this code to help isolate the problem. It may be related to data on the templet. This code loops through the columms A23:BT23 and tries to find which column data is causing the error 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).Select Selection.AutoFill _ Destination:= _ NewTempl.Range(ToRange), _ Type:=xlFillDefault Next Colcount End With Exit Sub err1: MsgBox ("Error in cell " & lastcelladdr) End Sub "Mikaela" wrote: First time thru the loop. |
#23
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to copy rows into an Excel *template* with vba
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 "Mikaela" wrote: 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: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 "Joel" wrote: 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. "Mikaela" wrote: Have run this and these are the results: 1st try - the msgbox pops up stating "Error in cell ". (strangely there was no cell address appended to the msg). 2nd try - received this error "Run-time error '1004'. Application-defined or object-defined error". The autofill ceases to run at column Q. 3rd try and onwards the code ran smoothly without any problem. The inconsistency of the results is very peculiar as I didn't modify the code in between any of the tries..... "Joel" wrote: If you are still getting an error try this code to help isolate the problem. It may be related to data on the templet. This code loops through the columms A23:BT23 and tries to find which column data is causing the error 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).Select Selection.AutoFill _ Destination:= _ NewTempl.Range(ToRange), _ Type:=xlFillDefault Next Colcount End With Exit Sub err1: MsgBox ("Error in cell " & lastcelladdr) End Sub "Mikaela" wrote: First time thru the loop. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
VBA to copy a template worksheet to new excel workbook | Excel Programming | |||
excel copy cells to word template | Excel Programming | |||
How do I copy protect an Excel template | Excel Discussion (Misc queries) | |||
Need One Excel Template to copy to TWO Databases | Excel Discussion (Misc queries) | |||
How do I copy a template in Excel? | Excel Worksheet Functions |