Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
script to send data from worksheet to multiple workbooks
Hi. Can anybody offer me some words of wisdom on how to approach the
following... I want to create a data entry worksheet that links to multiple workbooks. To be more specific, the data entry worksheet is a school class mark book with perhaps up to 30 students listed with their grades entered into the relevent columns. I then would like to send each row of information (student name and grades) into the individual workbook for that student. The individual workbook contains worksheets for a student for all year levels that they are in over a 5 year period. The individual workbook is basically a profile where all the grades are crunched to provide a level of achievement. The individual workbook that crunches the numbers works beautifully. I am just trying to simplify data entry by developing a "mark book" where the data is then placed into each workbook. It is a drama to open each student workbook individually and enter data. Any suggestions?? Greg |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
script to send data from worksheet to multiple workbooks
yes, you can do this.
to make it easier i would handle it this way..... in worksheet, student's name is: Smith, Robert individual workbook for that student would be named Smith_personalgrades.xls then you can have a macro in the main workbook go down each row of the column that contains the student's names, extract the last name (all text before the comma) & call that variable sStudentName. have "_personalgrades.xls" saved as a variable. open workbook "sStudentName" & "_personalgrades.xls". copy & paste appropriate range info (that row & columns a-c, for instance). save & close student workbook. go on to next student. obviously this will take a lot of coding, but when you're done, it will work very quickly & do it all at once. i do something similar for my boss only the other way around with individual workbooks to the master workbook. hope this gets you started in the right direction! susan On Apr 20, 6:29 am, Greg wrote: Hi. Can anybody offer me some words of wisdom on how to approach the following... I want to create a data entry worksheet that links to multiple workbooks. To be more specific, the data entry worksheet is a school class mark book with perhaps up to 30 students listed with their grades entered into the relevent columns. I then would like to send each row of information (student name and grades) into the individual workbook for that student. The individual workbook contains worksheets for a student for all year levels that they are in over a 5 year period. The individual workbook is basically a profile where all the grades are crunched to provide a level of achievement. The individual workbook that crunches the numbers works beautifully. I am just trying to simplify data entry by developing a "mark book" where the data is then placed into each workbook. It is a drama to open each student workbook individually and enter data. Any suggestions?? Greg |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
script to send data from worksheet to multiple workbooks
On Apr 20, 10:17 pm, Susan wrote:
yes, you can do this. to make it easier i would handle it this way..... in worksheet, student's name is: Smith, Robert individual workbook for that student would be named Smith_personalgrades.xls then you can have a macro in the main workbook go down each row of the column that contains the student's names, extract the last name (all text before the comma) & call that variable sStudentName. have "_personalgrades.xls" saved as a variable. open workbook "sStudentName" & "_personalgrades.xls". copy & paste appropriate range info (that row & columns a-c, for instance). save & close student workbook. go on to next student. obviously this will take a lot of coding, but when you're done, it will work very quickly & do it all at once. i do something similar for my boss only the other way around with individual workbooks to the master workbook. hope this gets you started in the right direction! susan On Apr 20, 6:29 am, Greg wrote: Hi. Can anybody offer me some words of wisdom on how to approach the following... I want to create a data entry worksheet that links to multiple workbooks. To be more specific, the data entry worksheet is a school class mark book with perhaps up to 30 students listed with their grades entered into the relevent columns. I then would like to send each row of information (student name and grades) into the individual workbook for that student. The individual workbook contains worksheets for a student for all year levels that they are in over a 5 year period. The individual workbook is basically a profile where all the grades are crunched to provide a level of achievement. The individual workbook that crunches the numbers works beautifully. I am just trying to simplify data entry by developing a "mark book" where the data is then placed into each workbook. It is a drama to open each student workbook individually and enter data. Any suggestions?? Greg- Hide quoted text - - Show quoted text - Thanks Susan I don't suppose you can point to something similar to what you suggested? My skill in writing scripts is below limited! I have had good success in achieving my goals by finding a script that does something similar to what I want and then spend hours reverse engineering it and changing it to suit. Greg |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
script to send data from worksheet to multiple workbooks
sorry for the delay, greg, i don't have internet access on the
weekend........ :) yes, here is some working coding........ like i said, this is somewhat backwards, but it should give you some ideas. this is a monthly workbook that when you press the "update" button it calls up a userform in which my boss can choose which program's info she wants to export, then automatically exports the info to a master workbook (RPCbook1.xls). the macro is stored in the monthly book, called invoices.xls. future improvements: the "if month" section could probably be changed to a case statement, but i haven't worked on that yet. also, the whole "if chkbox*** = true then" could be made into a case statement with a variable for the program name. complete the "add new" feature. :) hope this helps! module names are listed. in the interim i will work on something small that does what you specifically wanted. susan =========================== Document: <dateInvoices.xls Module: GlobalDeclarations Option Explicit Public wbMyInvoices As Workbook Public wsMyIndirectSheet As Worksheet Public wbMyRPC As Workbook Public wsMyRPCSheet As Worksheet Public Month, m, PrevMonth As Integer Public dt As Date Public Jan, Feb, Mar As Worksheet Public Apr, May, Jun As Worksheet Public Jul, Aug, Sep As Worksheet Public Oct, Nov, Dec As Worksheet Public Sum As Worksheet Public r As Range Public StartRow, EndRow As Long Public rFound, myCosts, StartPoint As Range Public InvoicePercent, RPCPercent, rReturn As Range Public chkTotal, chkAHC06, chkDANC05 As Control Public chkHPG05, chkHPG06, chkLCHOME05 As Control Public chkCHDO06, chkCro, chkLCHBYR05 As Control Public chkMicro, chkAccess, chkRentals, chkRPC As Control Public chkKeepOpen As Boolean Public chkAddNew, chkNew, refNewName As Control Public myNewName, myProgram As String Public cmdExport As Control Public Sub MonthNumber() 'Set Current Date. dt = DateTime.Date 'Break up the date. m = DateTime.Month(dt) If m <= 1 Then PrevMonth = (m + 11) End If If m = 2 Then PrevMonth = (m - 1) End If End Sub Public Sub Select_Sheet() Set Jan = Workbooks("RPC Book1.xls").Worksheets("Sheet1") Set Feb = Workbooks("RPC Book1.xls").Worksheets("Sheet2") Set Mar = Workbooks("RPC Book1.xls").Worksheets("Sheet3") Set Apr = Workbooks("RPC Book1.xls").Worksheets("Sheet4") Set May = Workbooks("RPC Book1.xls").Worksheets("Sheet5") Set Jun = Workbooks("RPC Book1.xls").Worksheets("Sheet6") Set Jul = Workbooks("RPC Book1.xls").Worksheets("Sheet7") Set Aug = Workbooks("RPC Book1.xls").Worksheets("Sheet8") Set Sep = Workbooks("RPC Book1.xls").Worksheets("Sheet9") Set Oct = Workbooks("RPC Book1.xls").Worksheets("Sheet10") Set Nov = Workbooks("RPC Book1.xls").Worksheets("Sheet11") Set Dec = Workbooks("RPC Book1.xls").Worksheets("Sheet12") Set Sum = Workbooks("RPC Book1.xls").Worksheets("Summary") If PrevMonth = 1 Then Jan.Select End If If PrevMonth = 2 Then Feb.Select End If If PrevMonth = 3 Then Mar.Select End If If PrevMonth = 4 Then Apr.Select End If If PrevMonth = 5 Then May.Select End If If PrevMonth = 6 Then Jun.Select End If If PrevMonth = 7 Then Jul.Select End If If PrevMonth = 8 Then Aug.Select End If If PrevMonth = 9 Then Sep.Select End If If PrevMonth = 10 Then Oct.Select End If If PrevMonth = 11 Then Nov.Select End If If PrevMonth = 12 Then Dec.Select End If Set rReturn = ActiveSheet.Range("a2") End Sub Module: OpenForm Option Explicit Sub MyExports_click() Load UserForm1 UserForm1.Show End Sub Module: ExportValues Option Explicit Public Sub ActualCopy() Set r = wsMyIndirectSheet.Columns("G") 'find the program name in wsMyIndirectSheet Set rFound = r.Find(What:=myProgram, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ MatchCase:=False) If rFound Is Nothing Then MsgBox "Sorry, " & myProgram & " was not found" _ & vbCrLf & _ "in the Invoice sheet." Exit Sub End If StartRow = rFound.End(xlToLeft) _ .End(xlToLeft).End(xlDown).End(xlDown).Row EndRow = rFound.End(xlToLeft).End(xlToLeft) _ .End(xlDown).End(xlDown) _ .End(xlDown).Offset(-1, 0).Row 'set the 2 ranges you will need to copy Set myCosts = wsMyIndirectSheet.Range("h" & StartRow & ":h" & EndRow) Set InvoicePercent = rFound.Offset(5, -1) myCosts.Copy 'find the appropriate column in wsMyRPCSheet '& then paste Set StartPoint = wsMyRPCSheet.Range("a4") Set r = StartPoint.EntireRow Set rFound = r.Find(What:=myProgram, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ MatchCase:=False) If rFound Is Nothing Then MsgBox "Sorry, " & myProgram & " was not found" _ & vbCrLf & _ "in the RPC sheet." Exit Sub End If Set StartPoint = rFound.Offset(1, 0) '.Address StartPoint.PasteSpecial (xlPasteValues) 'then offset 5 columns (to column F) for InvoicePercent.Copy Set RPCPercent = rFound.Offset(20, 0) RPCPercent.PasteSpecial (xlPasteValues) End Sub Public Sub Overhead() 'Public wsMyIndirectSheet As Worksheet 'Public wsMyRPCSheet As Worksheet wsMyRPCSheet.Range("n25") = wsMyIndirectSheet.Range("q1") wsMyRPCSheet.Range("n26") = wsMyIndirectSheet.Range("q2") wsMyRPCSheet.Range("n27") = wsMyIndirectSheet.Range("q4") wsMyRPCSheet.Range("n28") = wsMyIndirectSheet.Range("q3") End Sub Module: Userform1 code Option Explicit ' 'this workbook contains a 'set of macros designed and developed 'by Susan 'for xxxxxx 'completed 12/22/06 except for 'add new boxes; maybe do later ' 'revised 12/29/06 to add progress 'bar coding 'revised 2/13/07 to add HPG 2006 & remove 'Croghan CDBG ' Sub UserForm_Initialize() 'check all the boxes automatically except for 'the keepopen and addnew checkboxes Dim oControl As Control For Each oControl In Me.Controls If TypeOf oControl Is msforms.CheckBox Then oControl.Value = True End If Next oControl With Me ..chkAddNew.Value = False ..chkKeepOpen.Value = False ..cmdExport.SetFocus End With End Sub Sub cmdExport_click() Me.Hide 'check if the addnew checkbox is true 'if it is, then call addanother (in future) If Me.chkAddNew.Value = True Then MsgBox "The ""Add a New Program"" feature is currently not available." _ & vbCrLf & _ vbCrLf & _ "Please e-mail Susan and have her add the new program manually." _ & vbCrLf & _ vbCrLf & _ " Signed, your friend, the Computer.", vbOKOnly, "Whoops!" End If Application.ScreenUpdating = False call Main Unload Me Application.ScreenUpdating = True MsgBox "All values have been exported." _ & vbCrLf & _ vbCrLf & _ "Have a nice day!", vbOKOnly, "We're finished now..." End Sub Module: MainProgram Option Explicit Sub Main() ProgressForm.chkWkshtCode.Value = True Set wbMyInvoices = ThisWorkbook Set wsMyIndirectSheet = ActiveSheet Workbooks.Open Filename:="\\Server\users\Susan\My Documents \Miscellaneous\Excel Help\Macro Projects-Excel\RPC Book1.xls" 'open the correct worksheet by month Call MonthNumber Call Select_Sheet Set wbMyRPC = ActiveWorkbook Set wsMyRPCSheet = ActiveSheet 'go thru all the checkboxes & copy if needed If UserForm1.chkTotal.Value = True Then myProgram = UserForm1.chkTotal.Caption Call ActualCopy End If If UserForm1.chkAHC06.Value = True Then myProgram = UserForm1.chkAHC06.Caption Call ActualCopy End If If UserForm1.chkDANC05.Value = True Then myProgram = UserForm1.chkDANC05.Caption Call ActualCopy End If 'If UserForm1.chkHPG05.Value = True Then 'myProgram = UserForm1.chkHPG05.Caption 'Call ActualCopy 'End If If Userform1.chkHPG06.Value = True Then myProgram = UserForm1.chkHPG06.Caption Call ActualCopy End If If UserForm1.chkLCHOME05.Value = True Then myProgram = UserForm1.chkLCHOME05.Caption Call ActualCopy End If If UserForm1.chkCHDO06.Value = True Then myProgram = UserForm1.chkCHDO06.Caption Call ActualCopy End If 'If UserForm1.chkCro.Value = True Then 'myProgram = UserForm1.chkCro.Caption 'Call ActualCopy 'End If If UserForm1.chkLCHBYR05.Value = True Then myProgram = UserForm1.chkLCHBYR05.Caption Call ActualCopy End If If UserForm1.chkMicro.Value = True Then myProgram = UserForm1.chkMicro.Caption Call ActualCopy End If 'If Userform1.chkAccess.Value = True Then 'myProgram = UserForm1.chkAccess.Caption 'Call ActualCopy 'End If If UserForm1.chkRentals.Value = True Then myProgram = UserForm1.chkRentals.Caption Call ActualCopy End If If UserForm1.chkRPC.Value = True Then myProgram = UserForm1.chkRPC.Caption Call ActualCopy End If 'after all values exported, save both workbooks 'check if keepopen chkbox is true 'if not, close wbMyRPC Call Overhead rReturn.Select If UserForm1.chkKeepOpen.Value = False Then Application.DisplayAlerts = False wbMyRPC.Save wbMyRPC.Close Application.DisplayAlerts = True End If wbMyInvoices.Save End Sub ============================= On Apr 20, 8:24 pm, Greg wrote: On Apr 20, 10:17 pm, Susan wrote: yes, you can do this. to make it easier i would handle it this way..... in worksheet, student's name is: Smith, Robert individual workbook for that student would be named Smith_personalgrades.xls then you can have a macro in the main workbook go down each row of the column that contains the student's names, extract the last name (all text before the comma) & call that variable sStudentName. have "_personalgrades.xls" saved as a variable. open workbook "sStudentName" & "_personalgrades.xls". copy & paste appropriate range info (that row & columns a-c, for instance). save & close student workbook. go on to next student. obviously this will take a lot of coding, but when you're done, it will work very quickly & do it all at once. i do something similar for my boss only the other way around with individual workbooks to the master workbook. hope this gets you started in the right direction! susan On Apr 20, 6:29 am, Greg wrote: Hi. Can anybody offer me some words of wisdom on how to approach the following... I want to create a data entry worksheet that links to multiple workbooks. To be more specific, the data entry worksheet is a school class mark book with perhaps up to 30 students listed with their grades entered into the relevent columns. I then would like to send each row of information (student name and grades) into the individual workbook for that student. The individual workbook contains worksheets for a student for all year levels that they are in over a 5 year period. The individual workbook is basically a profile where all the grades are crunched to provide a level of achievement. The individual workbook that crunches the numbers works beautifully. I am just trying to simplify data entry by developing a "mark book" where the data is then placed into each workbook. It is a drama to open each student workbook individually and enter data. Any suggestions?? Greg- Hide quoted text - - Show quoted text - Thanks Susan I don't suppose you can point to something similar to what you suggested? My skill in writing scripts is below limited! I have had good success in achieving my goals by finding a script that does something similar to what I want and then spend hours reverse engineering it and changing it to suit. Greg- Hide quoted text - - Show quoted text - |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
script to send data from worksheet to multiple workbooks
ok, greg, here's what i've got for you.
this is controlled by a command button on the main worksheet....... Option Explicit Private Sub CommandButton1_Click() Call Export End Sub Option Explicit Public lName As String Public fName As String Public mName As String Public sRank As String Public iloc As Integer Public rRange, GroupRange, PersonRange As Range Public wb1, wb2 As Workbook Public ws1, ws2 As Worksheet Public iRow, iiRow As Integer Public c As Range Public sStudent As String Public sFile, sPath As String ' Public Sub Export() Set wb1 = ActiveWorkbook Set ws1 = ActiveSheet 'CHANGE rRange TO YOUR ACTUAL RANGE OF 'STUDENT'S NAMES Set rRange = ws1.Range("a3:a7") 'CHANGE sPath TO YOUR ACTUAL PATH sPath = "\\Server\users\Susan\My Documents\Miscellaneous\01Excel\Macro Projects-Excel\Tests\PersonalWkbks\" 'go to the top of the range that has the student's names ws1.Range("a3").Select iRow = ActiveCell.Row For Each c In rRange 'this is the range of the old workbook with all the students 'that is JUST the row of the one student you're working 'on Set GroupRange = ws1.Range("b" & iRow & ":g" & iRow) Call SplitName(c) sStudent = lName sFile = "_personalgrades.xls" Workbooks.Open Filename:=sPath & sStudent & sFile Set wb2 = ActiveWorkbook Set ws2 = ActiveSheet 'iiRow is the first blank row in column B - column A contains 'the student's name in my sample workbook. iiRow = ws2.Cells(5000, 2).End(xlUp).Offset(1, 0).Row 'this is the range in the individual's workbook 'it contains just one row Set PersonRange = ws2.Range("b" & iiRow & ":g" & iiRow) GroupRange.Copy PersonRange.PasteSpecial wb2.Save wb2.Close iRow = iRow + 1 Next c End Sub Public Sub SplitName(sName) sName = Trim(sName) 'this is taking spaces off the end or beginning of the name iloc = InStr(sName, ",") 'this is the # position of the comma lName = Left(sName, iloc - 1) 'this is the last name, before the comma 'sub above taken from newsgroup with this 'disclaimer from Tom: 'the sub above won't correctly handle ' 'Smith, Joe Bob R. Pvt 'Smith, Mike Cpl 'Smith, Bill H Pfc ' 'Regards, 'Tom Ogilvy End Sub it worked for me with limited testing. HTH! :) susan |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
script to send data from worksheet to multiple workbooks
On Apr 24, 12:20 am, Susan wrote:
ok, greg, here's what i've got for you. this is controlled by a command button on the main worksheet....... Option Explicit Private Sub CommandButton1_Click() Call Export End Sub Option Explicit Public lName As String Public fName As String Public mName As String Public sRank As String Public iloc As Integer Public rRange, GroupRange, PersonRange As Range Public wb1, wb2 As Workbook Public ws1, ws2 As Worksheet Public iRow, iiRow As Integer Public c As Range Public sStudent As String Public sFile, sPath As String ' Public Sub Export() Set wb1 = ActiveWorkbook Set ws1 = ActiveSheet 'CHANGE rRange TO YOUR ACTUAL RANGE OF 'STUDENT'S NAMES Set rRange = ws1.Range("a3:a7") 'CHANGE sPath TO YOUR ACTUAL PATH sPath = "\\Server\users\Susan\My Documents\Miscellaneous\01Excel\Macro Projects-Excel\Tests\PersonalWkbks\" 'go to the top of the range that has the student's names ws1.Range("a3").Select iRow = ActiveCell.Row For Each c In rRange 'this is the range of the old workbook with all the students 'that is JUST the row of the one student you're working 'on Set GroupRange = ws1.Range("b" & iRow & ":g" & iRow) Call SplitName(c) sStudent = lName sFile = "_personalgrades.xls" Workbooks.Open Filename:=sPath & sStudent & sFile Set wb2 = ActiveWorkbook Set ws2 = ActiveSheet 'iiRow is the first blank row in column B - column A contains 'the student's name in my sample workbook. iiRow = ws2.Cells(5000, 2).End(xlUp).Offset(1, 0).Row 'this is the range in the individual's workbook 'it contains just one row Set PersonRange = ws2.Range("b" & iiRow & ":g" & iiRow) GroupRange.Copy PersonRange.PasteSpecial wb2.Save wb2.Close iRow = iRow + 1 Next c End Sub Public Sub SplitName(sName) sName = Trim(sName) 'this is taking spaces off the end or beginning of the name iloc = InStr(sName, ",") 'this is the # position of the comma lName = Left(sName, iloc - 1) 'this is the last name, before the comma 'sub above taken from newsgroup with this 'disclaimer from Tom: 'the sub above won't correctly handle ' 'Smith, Joe Bob R. Pvt 'Smith, Mike Cpl 'Smith, Bill H Pfc ' 'Regards, 'Tom Ogilvy End Sub it worked for me with limited testing. HTH! :) susan Ah Susan! Your an angel!!! Thank you so much. You really must have a passion for this stuff. Greg |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
script to send data from worksheet to multiple workbooks
yep...... guilty as charged!
i'm very glad it worked! a lot of it is just learning to comb the newsgroup & pulling out bits & pieces of what you need, and then combining it to work as one sub. susan On Apr 24, 5:55 am, Greg wrote: On Apr 24, 12:20 am, Susan wrote: ok, greg, here's what i've got for you. this is controlled by a command button on the main worksheet....... Option Explicit Private Sub CommandButton1_Click() Call Export End Sub Option Explicit Public lName As String Public fName As String Public mName As String Public sRank As String Public iloc As Integer Public rRange, GroupRange, PersonRange As Range Public wb1, wb2 As Workbook Public ws1, ws2 As Worksheet Public iRow, iiRow As Integer Public c As Range Public sStudent As String Public sFile, sPath As String ' Public Sub Export() Set wb1 = ActiveWorkbook Set ws1 = ActiveSheet 'CHANGE rRange TO YOUR ACTUAL RANGE OF 'STUDENT'S NAMES Set rRange = ws1.Range("a3:a7") 'CHANGE sPath TO YOUR ACTUAL PATH sPath = "\\Server\users\Susan\My Documents\Miscellaneous\01Excel\Macro Projects-Excel\Tests\PersonalWkbks\" 'go to the top of the range that has the student's names ws1.Range("a3").Select iRow = ActiveCell.Row For Each c In rRange 'this is the range of the old workbook with all the students 'that is JUST the row of the one student you're working 'on Set GroupRange = ws1.Range("b" & iRow & ":g" & iRow) Call SplitName(c) sStudent = lName sFile = "_personalgrades.xls" Workbooks.Open Filename:=sPath & sStudent & sFile Set wb2 = ActiveWorkbook Set ws2 = ActiveSheet 'iiRow is the first blank row in column B - column A contains 'the student's name in my sample workbook. iiRow = ws2.Cells(5000, 2).End(xlUp).Offset(1, 0).Row 'this is the range in the individual's workbook 'it contains just one row Set PersonRange = ws2.Range("b" & iiRow & ":g" & iiRow) GroupRange.Copy PersonRange.PasteSpecial wb2.Save wb2.Close iRow = iRow + 1 Next c End Sub Public Sub SplitName(sName) sName = Trim(sName) 'this is taking spaces off the end or beginning of the name iloc = InStr(sName, ",") 'this is the # position of the comma lName = Left(sName, iloc - 1) 'this is the last name, before the comma 'sub above taken from newsgroup with this 'disclaimer from Tom: 'the sub above won't correctly handle ' 'Smith, Joe Bob R. Pvt 'Smith, Mike Cpl 'Smith, Bill H Pfc ' 'Regards, 'Tom Ogilvy End Sub it worked for me with limited testing. HTH! :) susan Ah Susan! Your an angel!!! Thank you so much. You really must have a passion for this stuff. Greg- Hide quoted text - - Show quoted text - |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
vba to send multiple workbooks to different address | Excel Discussion (Misc queries) | |||
getting data from excel worksheet in to a script | Excel Programming | |||
getting data from excel worksheet in to a script | Excel Discussion (Misc queries) | |||
Send Mail Script Help | Excel Programming | |||
Script to send | Excel Programming |