PDA

View Full Version : Solved: Insert name and auto save as... macro help



pireng
12-09-2009, 10:47 AM
I want/need a macro that will use an existing excel file that has a list of employee names in it and have it open an existing blank timecard excel file and have it automatically add the person’s name to it and then save the file as the person’s name and the go to the next person on the list… clear as mud right… thanks for any and all assistance… DRG

Simon Lloyd
12-09-2009, 11:11 AM
Something like this....not tested, but create a template of your time sheet and adjust the worksheets and ranages to suit.
Sub name_it()
Dim Rng As Range, MyCell As Range, ThisBook As String
ThisBook = ThisWorkbook.Name
Workbooks.Open ("C:\Documents and Settings\gbksxl04\Desktop\" & "testit.xlt")
Set Rng = Workbooks(ThisBook).Sheets("Sheet1").Range("A2:A" & _
Workbooks(ThisBook).Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
MsgBox Rng.Address
For Each MyCell In Rng
ActiveWorkbook.Sheets("Sheet1").Range("A1").Value = MyCell.Value
ActiveWorkbook.SaveAs MyCell.Value & ".xls"
ActiveWorkbook.Close
Next MyCell
Workbooks(ThisBook).Activate
Workbooks("testit.xlt").Close False
End Sub

mdmackillop
12-09-2009, 11:34 AM
Very similar

Sub TimeCard()
Dim cel As Range, WB As Workbook, Pth As String
Pth = "C:\MyPath\"
Application.ScreenUpdating = False
For Each cel In Range("Names")
Set WB = Workbooks.Open(Pth & "Test.xlt")
WB.Sheets(1).Cells(1, 1) = cel
WB.SaveAs Pth & cel & ".xls"
WB.Close
Application.ScreenUpdating = True
Next
End Sub

pireng
12-09-2009, 01:03 PM
Thanks… for the replies… more info. that I should have included in my first post…
There are 150 employees (approx.) and there are a couple of different timecard blanks. One for each different Union. So I would select a group of employee names and apply their info to the correct timecard.

The employee’s are in an excel worksheet named “employee list.xls”
Column A is the person’s employee number
Column B is the person’s name
Column C is the person’s department

I need those three items to be inserted into a timecard.

The time card blank that I need that info put into is named “2010 timecard.xls”
Information is placed on the first tab which is called “TS1”
Cell A,3 is the person’s name
Cell A,4 is the person’s employee number
Cell I,3 is the department

I then want it to save the file as the person’s name and goto the next name on the list.

Thanks so much for the help…DRG

Simon Lloyd
12-09-2009, 03:08 PM
A workbook would help, either that or try to adapt one of the solutions given to you then post back.

pireng
12-09-2009, 03:34 PM
I have attached the timecard file... I will try and adapt what you gave me... but i'm hoping someone can help further...thanks_DRG

mdmackillop
12-09-2009, 04:15 PM
Sub TimeCard()
Dim cel As Range, WB As Workbook, Pth As String
Pth = "C:\MyPath\"
Application.ScreenUpdating = False
For Each cel In Selection
Set WB = Workbooks.Open(Pth & "2010 timecard.xls")
With WB
.Sheets("TS1").Cells(3, 1) = cel
.Sheets("TS1").Cells(4, 1) = cel.Offset(, 1)
.Sheets("TS1").Cells(3, 8) = cel.Offset(, 2)
.SaveAs Pth & cel & ".xls"
.Close
End With
Application.ScreenUpdating = True
Next
End Sub

pireng
12-10-2009, 08:49 AM
I'm close.. but a couple of questions...
If i move the "name" field to the A column and hightlight the names, it creates the time cards... but it removes the word "Department" if front of what is inserted.... and saves the all the files to My Documents folder... I can live with it but I would like the word Department to stay and for the files to be saved in the same folder as the timecard blank and name list... thanks for your help...DRG

pireng
12-11-2009, 07:15 AM
I have this working except for one issue. How can i control where the new files are saved to? Currently the code saves the newly created files to the "My Documents" folder... i would like to have it save them to the folder where name list is held... Thanks_DRG

Simon Lloyd
12-11-2009, 11:55 AM
I have this working except for one issue. How can i control where the new files are saved to? Currently the code saves the newly created files to the "My Documents" folder... i would like to have it save them to the folder where name list is held... Thanks_DRGreplace this Pth = "C:\MyPath\" for your path! like Pth = "C:\Names Folder\The Names"

pireng
12-11-2009, 12:21 PM
I have the pth statement as the correct folder... "C:\2010 Timecards\"... I don't know where it is coming up with "C:\Documents and Settings\user\My Documents"...to save the new files in...

Simon Lloyd
12-11-2009, 02:34 PM
Can you attach the offending workbook including the code?. md'd code is correct and should save as you expect.

pireng
12-11-2009, 03:34 PM
Attached; Name List and below is the code...



Sub CreateAdminTimeCards()
Dim cel As Range, WB As Workbook, Pth As String
Pth = "C:\2010 Timecards\"
Application.ScreenUpdating = False
For Each cel In Selection
Set WB = Workbooks.Open(Pth & "2010 Admin.xls")
With WB
.Sheets("TS1").Cells(3, 1) = cel
.Sheets("TS1").Cells(4, 1) = cel.Offset(, 1)
.Sheets("TS1").Cells(3, 9) = cel.Offset(, 2)
.SaveAs cel & ".xls"
.Close
End With
Application.ScreenUpdating = True
Next
End Sub

pireng
12-11-2009, 03:39 PM
Attached Blank Timecard...

I am able to use this the way it is... so its not a big deal, but it would be nice if it would create its own folders based on the department of each employee to save them in...

Thank you for all your help....

Simon Lloyd
12-11-2009, 08:02 PM
This should do you:
Sub CreateAdminTimeCards()
Dim cel As Range, WB As Workbook, Pth As String
Pth = "C:\2010 Timecards\"
Application.ScreenUpdating = False
For Each cel In Selection
Set WB = Workbooks.Open(Pth & "2010 Admin.xls")
With WB
.Sheets("TS1").Cells(3, 1) = cel
.Sheets("TS1").Cells(4, 1) = cel.Offset(, 1)
.Sheets("TS1").Cells(3, 9) = cel.Offset(, 2)
.SaveAs (ActiveWorkbook.Path & "\" & cel & ".xls")
.Close
End With
Application.ScreenUpdating = True
Next
End Sub

pireng
12-14-2009, 09:07 AM
Everything works good... only thing that would be helpful is if the file could save itself to a sub folder depending on its department... so if your department from the name list is "Admin" it saves those names to C:\2010 Timecards\Admin and if it is Business it saves them to C:\2010 Timecards\Business and so on....

Thank you for your expertise... it is much appreciated... if this is possible great, if not that is fine too... if you could let me know either way i will then mark this thread as Solved... again Thank you.:clap:

mdmackillop
12-14-2009, 09:28 AM
Hi Pireng,
Try modifying this line. Check the location of the data and add it into the string.


.SaveAs (ActiveWorkbook.Path & "\" & cel & ".xls")

pireng
12-14-2009, 12:47 PM
Thanks... unfortunatly every rendition i come up with gives an error... the data is in the third cell, or column C and


.SaveAs (ActiveWorkbook.Path & "\" & cel & ".xls")

is obviously the line to add the data too, i just don't know the proper format...

mdmackillop
12-14-2009, 03:13 PM
.SaveAs (ActiveWorkbook.Path & "\" & cel.offset(,2) & "\" & cel & ".xls")

pireng
12-14-2009, 03:51 PM
works like a champ...Thank you!

mdmackillop
12-15-2009, 04:04 PM
Sub CreateAdminTimeCards()
Dim cel As Range, WB As Workbook, Pth As String
Dim fs, SubPth As String
Set fs = CreateObject("Scripting.FileSystemObject")
Pth = "C:\2010 Timecards\"
Application.ScreenUpdating = False

SubPth = ActiveWorkbook.Path & "\" & cel.Offset(, 2)
If Not fs.folderexists(SubPth) Then MkDir SubPth

For Each cel In Selection
Set WB = Workbooks.Open(Pth & "2010 Admin.xls")
With WB
.Sheets("TS1").Cells(3, 1) = cel
.Sheets("TS1").Cells(4, 1) = cel.Offset(, 1)
.Sheets("TS1").Cells(3, 9) = cel.Offset(, 2)
.SaveAs (SubPth & "\" & cel & ".xls")
.Close
End With
Application.ScreenUpdating = True
Next
End Sub

pireng
12-16-2009, 07:28 AM
When i run this I get

Run-time error '91':
Object variable or With block variable not set

when i hit debug it highlights this line


SubPth = ActiveWorkbook.Path & "\" & cel.Offset(, 2)

pireng
12-17-2009, 01:51 PM
Can anyone help with the error i get with this code??

Its so close to doing what i want I hate to give up now...

Thanks