Compile Data from Multiple Users based on Criteria

[Curben]

I have a few people all entering in data into excel, since they cannot be all in one sheet they each have their own copy. I would like to be able to extract all data where column P reads "Red" from each users spreadsheet and then delete the corresponding lines from their spreadsheet (end of day activity)

The Sheets will be named
FDEntryU1AM.xlsm
FDEntryU2AM.xlsm
FDEntryU3AM.xlsm
FDEntryU4AM.xlsm
FDEntryL1AM.xlsm
FDEntryU1PM.xlsm
FDEntryU2PM.xlsm
FDEntryU3PM.xlsm
FDEntryU4PM.xlsm
FDEntryL1PM.xlsm

I will then need to do the same in another workbook for all items Labeled Blue, but that of course will be same code with just an item replaced.
The idea is after they close up the person oversseing the data can import all at once and leave the users with fresh empty workbooks.

Any help would be appreciated

 

[Trevor G]

Yes you might also need a string line for the folder location for the workbooks which would have to be added. Something like:

Dim StrPath As String
set StrPath = "W:\Forms\FD User Entry Forms\"

Then in the Workbooks open you would use the StrPath, like this

Set myWorkbook = Workbooks.Open(FileName:=StrPath & avData(i) & ".xlsm")

 

[Curben]

What about something like this then.

[FONT=Courier][COLOR=#00007f]Sub[/COLOR] Open_My_Files()
[COLOR=#007f00]'Open all workbooks and do something[/COLOR]
[COLOR=#00007f]Dim[/COLOR] MyFile [COLOR=#00007f]As[/COLOR] [COLOR=#00007f]String[/COLOR]
[COLOR=#00007f]Dim[/COLOR] ws [COLOR=#00007f]As[/COLOR] Worksheet
[COLOR=#00007f]Dim[/COLOR] myPath [COLOR=#00007f]As[/COLOR] [COLOR=#00007f]String[/COLOR]
myPath = "M:\Access Files\" [COLOR=#007f00]'Change path[/COLOR]
MyFile = Dir(myPath)

[COLOR=#00007f]Do[/COLOR] [COLOR=#00007f]While[/COLOR] MyFile <> ""
[COLOR=#00007f]If[/COLOR] MyFile [COLOR=#00007f]Like[/COLOR] "*.xls" [COLOR=#00007f]Then[/COLOR]
Workbooks.Open myPath & MyFile

[COLOR=#00007f]With[/COLOR] Sheets("Sheet1")
LR = .Range("p" & Rows.Count).End(xlUp).Row
[COLOR=#00007f]For[/COLOR] i = 1 [COLOR=#00007f]To[/COLOR] LR
[COLOR=#00007f]If[/COLOR] .Range("p" & i).Value = "Red" [COLOR=#00007f]Then[/COLOR] .Rows(i).Copy Destination:=Workbooks.Open("M:\Access Files\tblStaff Import.xls").Sheets("Staff").Range("A" & Rows.Count).End(xlUp).Offset(1) [COLOR=seagreen]'Change workbook name and sheet name[/COLOR]
[COLOR=#00007f]Next[/COLOR] i
[COLOR=#00007f]End[/COLOR] [COLOR=#00007f]With[/COLOR]

[COLOR=#00007f]Next[/COLOR] ws
ActiveWorkbook.Close [COLOR=#00007f]True[/COLOR]
[COLOR=#00007f]End[/COLOR] [COLOR=#00007f]If[/COLOR]
MyFile = Dir
[COLOR=#00007f]Loop[/COLOR]
[COLOR=#00007f]End[/COLOR] [COLOR=#00007f]Sub[/COLOR][/FONT]

While I never got this method to work right for this particular projext, I have been able to get it to work for a handful of others so i just wanted to make sure I came back and said thanks.