| Home | Forums | Reviews | Articles | Register |
 |
| Thread Tools | Rate Thread |
|
=?Utf-8?B?TWlrYWVsYQ==?=
Guest
Posts: n/a
|
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 structure: ================================ 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 |
|
||
|
||||
|
|
|
| |
|
=?Utf-8?B?Sm9lbA==?=
Guest
Posts: n/a
|
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 structure: > ================================ > 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 |
|
||
|
|
||||
|
=?Utf-8?B?TWlrYWVsYQ==?=
Guest
Posts: n/a
|
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 here: 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).xls" (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_AlanHudson.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 structure: > > ================================ > > 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 |
|
||
|
|
||||
|
=?Utf-8?B?Sm9lbA==?=
Guest
Posts: n/a
|
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 here: > > 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).xls" (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_AlanHudson.xls", > FileFormat:= _ |
|
||
|
|
||||
|
=?Utf-8?B?TWlrYWVsYQ==?=
Guest
Posts: n/a
|
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 here: > > > > 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).xls" (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 |
|
||
|
|
||||
|
=?Utf-8?B?Sm9lbA==?=
Guest
Posts: n/a
|
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 here: > > > > > > 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).xls" (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 |
|
||
|
|
||||
|
=?Utf-8?B?TWlrYWVsYQ==?=
Guest
Posts: n/a
|
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 = _ |
|
||
|
|
||||
|
=?Utf-8?B?Sm9lbA==?=
Guest
Posts: n/a
|
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, _ |
|
||
|
|
||||
|
=?Utf-8?B?TWlrYWVsYQ==?=
Guest
Posts: n/a
|
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 |
|
||
|
|
||||
|
=?Utf-8?B?Sm9lbA==?=
Guest
Posts: n/a
|
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 |
|
||
|
|
||||
|
|
|
| |
|
| Thread Tools | |
| Rate This Thread | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Copy info from one excel spreadsheet to an excel template | TB@work | Microsoft Excel Worksheet Functions | 2 | 21st Oct 2009 07:06 PM |
| Print only rows with data entered in an excel template | hellaby | Microsoft Excel Misc | 1 | 9th Aug 2008 04:16 PM |
| Export single rows from a query to excel using a template | Ernesto | Microsoft Access | 1 | 29th Aug 2007 01:02 PM |
| Hide rows that meet certain criteria in an excel template | =?Utf-8?B?U2FuZHlaYXBw?= | Microsoft Excel Worksheet Functions | 0 | 5th Jul 2006 09:34 PM |
| RE: Delete Rows from Protected Excel Template | =?Utf-8?B?R2VvZmYgTGlsbGV5?= | Microsoft Excel Misc | 0 | 31st Jul 2004 10:03 PM |
Powered by vBulletin®. Copyright ©2000 - 2012, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2010, Crawlability, Inc. |
