Macro for list (2003)

Topic

New Reply

Hello Everyone,

I need some help creating a macro to copy all the rows below hte facility type (row 5) and above the total hours row (row 9) for each timesheet. I will have many timesheets with quiet a few rows or none at all, depending on the amount of work an employee does. I need help creating a macro to extra this information to a new worksheet. Any help would be great.

Reply | Quote

Replies

Where will all of the time sheets be and how can they be recoginized? Will they all be in the same workbook? If so, will there be any other sheets in the workbook that are not time sheets, and if so how can the macro tell the difference? Or, will they be in separate workbooks? If so, where are those workbooks located, and how can they be recognized? And finally, where do you want the data copied?

Reply | Quote

The time sheets will be located in one file location (d:timesheetsjohndoe.xls). Each employee will have one time sheet per month (or one file with one worksheet per employee per month). The macro will be set up in one file location (summary.xls) with the one worksheet. I will like all the data to be put into one worksheet. hope this helps.

Reply | Quote

Should the target worksheet just contain the copied rows (without any indication of the employee and month/year they belong to), or do you want to include some kind of identification?

Reply | Quote

It would be great if it contain the employee’s name and monthyear, index. However. I would be happy to just get the information inbetween those rows I mentioned above. Anything else is a bonus. Thanks.

Reply | Quote

You could use code like this:

Sub ImportSheets()
‘ Modify as needed, but keep the trailing backslash
Const strPath = “D:Timesheets”
Dim strFile As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim rngTarget As Range
Dim lngSource As Long
strFile = Dir(strPath & “*.xls”)
Do While Not strFile = “”
Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
Set wsh = wbk.Worksheets(“TimeSheet”)
lngSource = wsh.Range(“A65536”).End(xlUp).Row
wsh.Range(“A:B”).Insert
wsh.Range(“A6:A” & lngSource) = wsh.Range(“D3”)
wsh.Range(“B6:B” & lngSource) = wsh.Range(“I3”)
Set rngTarget = ThisWorkbook.Worksheets(1).Range(“A65536”).End(xlUp).Offset(1, 0)
wsh.Range(“6:” & lngSource).Copy Destination:=rngTarget
wbk.Close SaveChanges:=False
strFile = Dir
Loop
Set rngTarget = Nothing
Set wsh = Nothing
Set wbk = Nothing
End Sub

This assumes that the specified folder (D:Timesheets) contains only timesheet workbooks, and no others, and that each timesheet workbook contains a sheet named TimeSheet.
See attached demo.

Reply | Quote

Thanks Hans, However, when I try the code, I still get the row below total hours and employee signatures. Is there a way I can get everything above the total hours? Also, If there are two files called timesheet1 and timesheet2, it will not add both, but replace the information. For example, if timesheet1 has three hours and time sheet two has 2 hours. The macro will only capture the two hours and delete the 1 hour. I need to be able to copy the information and keep on additing rows to the summary. Basically, what I am trying to do is to gather all the rows with hours only for each employee and then I plan on doing a pivot table to summarize the information. I just don’t want to go through each file for each employee and do this and thought if I can create a macro to do this it would help. Sorry if I made this more confusing.

Reply | Quote

I assumed that the TimeSheet worksheets would look like the one you attached. If the cells in column A to the left of Total Hours and Employee Signature are not blank, these rows will be included. Could that be the explanation?

Reply | Quote

Hans, I don’t know if I am thinking of it correctly. Basically, all I want to do is be able to copy all the rows that have hours associated with them from each employee timesheet. I need this for reporting purpose. I could go and grab each row, but we have over 500 employees and this would take some time. I though if I create a macro to pull this information, I could manipulate it easier, but I am open to any suggestions be it a macro, formual, or link. Thanks.

Reply | Quote

That doesn’t answer my question. Could you attach a more representative example?

Reply | Quote

Hans, Below is a code that someone in this forum was kind enough to share. I am interested in processing each file and extracting the information of the rows between the facility row and total column rows. I plan on puttting this code in a file called summary where I plan to process the macro. I want a sheet that gathers all the information from all the files for those rows between the facility and total colum.
Sub FileProcessingExample()
‘Variable Definition
Dim FilesToOpen
Dim iFileCount As Integer
Dim x As Integer

On Error GoTo ErrHandler
Application.ScreenUpdating = False

‘Get files to work with
FilesToOpen = Application.GetOpenFilename _
(FileFilter:=”Microsoft Excel Files (*.xls), *.xls”, _
MultiSelect:=True)

‘Quit if NO files are selected
If TypeName(FilesToOpen) = “Boolean” Then
MsgBox “No Files were selected”
GoTo ExitHandler
End If

‘Act on each file
iFileCount = UBound(FilesToOpen)
x = 1
While x <= iFileCount
Workbooks.Open Filename:=FilesToOpen(x)

'Process each
'This is where I want to put the code to pull the rows for each file.

End With

'Close workbook
ActiveWorkbook.Close SaveChanges:=False

'Get next file
x = x + 1
Wend

'Give a message saying you are done
If iFileCount = 1 Then
MsgBox "1 File was processed"
Else
MsgBox iFileCount & " Files were processed"
End If

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler

End Sub

I don't know if these helps. Again, Thanks for any help you could give me.

Reply | Quote

That still does not answer Hans’ question! He needs to see the worksheet that his code does not work on. He wrote the code to work on the worksheet you uploaded earlier. If it does not work on the real worksheet, there is some difference. He can’t fix the problem without seeing the real worksheet.

Reply | Quote

Hans and Legare, the code actually works for, I inserted some stuff into it and I went back to fix it. Thanks for all your help.

Reply | Quote

Continued in the thread starting at post 576,317.

Reply | Quote