Macro to consolidate a task list by date :)

[Jay3]

Can anyone help with this.

I have a spreadsheet with 5 tabs, 4 of the tabs relate to an individuals weekly to do list. The 5th Tab exists to give a consolidated view of the weekly deliverables in order of date accross the whole team.

I want to be able to click a button in the consolidated tab that will look at everyones tasks and populate the consolidated view in order of the deadlines.

Each of the tabs are in identical format with the following headings....Owner, Task, Time Required (HRS) and Deadline

The headings are all in Row 5, with "Owner" being entered in B5 and the other headings following consecutively.

This means that users will enter data in B6 through to E6 for their first task, B7 through to E7 for their second task and so on...

The users will enter task in their individual tabs as and when this occur to them and these tabs will not be in date order, however, the date is detailed in column E under the deadline heading.

The Macro will need to look at all the dates in each of the individual tabs in order to decide which task is deadlined the soonest.

Once the Macro has decided this it needs to copy the entire line to the cosolidated tab.

Can anyone help with this please?

Thanks,
Jay3

 

[Ruddles]

If I understand correctly, this should do the job:-

[FONT=Fixedsys]Option Explicit[/FONT]
 
[FONT=Fixedsys]Public Sub ConsolidateTasks()[/FONT]
 
[FONT=Fixedsys] Dim ws As Worksheet[/FONT]
[FONT=Fixedsys] Dim cws As Worksheet[/FONT]
 
[FONT=Fixedsys] Dim iConsolRow As Long[/FONT]
[FONT=Fixedsys] Dim iLastRow As Long[/FONT]
[FONT=Fixedsys] Dim iTaskRow As Long[/FONT]
 
[FONT=Fixedsys] Set cws = ThisWorkbook.Sheets("TEAM'S WEEKLY DELIVERABLES")[/FONT]
[FONT=Fixedsys] iLastRow = cws.Cells(cws.Rows.Count, "B").End(xlUp).Row + 1[/FONT]
[FONT=Fixedsys] cws.Range("B6:E" & iLastRow).ClearContents[/FONT]
 
[FONT=Fixedsys] iConsolRow = 5[/FONT]
[FONT=Fixedsys] For Each ws In ThisWorkbook.Worksheets[/FONT]
[FONT=Fixedsys]   If ws.Name <> cws.Name Then[/FONT]
[FONT=Fixedsys]     iLastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row[/FONT]
[FONT=Fixedsys]     For iTaskRow = 6 To iLastRow[/FONT]
[FONT=Fixedsys]       iConsolRow = iConsolRow + 1[/FONT]
[FONT=Fixedsys]       ws.Cells(iTaskRow, "B").Resize(1, 4).Copy Destination:=cws.Cells(iConsolRow, "B")[/FONT]
[FONT=Fixedsys]       cws.Rows(iConsolRow).RowHeight = cws.Rows(6).RowHeight[/FONT]
[FONT=Fixedsys]     Next iTaskRow[/FONT]
[FONT=Fixedsys]   End If[/FONT]
[FONT=Fixedsys] Next ws[/FONT]
 
[FONT=Fixedsys] With cws.Sort[/FONT]
[FONT=Fixedsys]   .SortFields.Clear[/FONT]
[FONT=Fixedsys]   .SortFields.Add Key:=Range("E6:E" & iConsolRow), SortOn:=xlSortOnValues, _[/FONT]
[FONT=Fixedsys]         Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
[FONT=Fixedsys]   .SetRange Range("B6:E" & iConsolRow)[/FONT]
[FONT=Fixedsys]   .Header = xlGuess[/FONT]
[FONT=Fixedsys]   .MatchCase = False[/FONT]
[FONT=Fixedsys]   .Orientation = xlTopToBottom[/FONT]
[FONT=Fixedsys]   .SortMethod = xlPinYin[/FONT]
[FONT=Fixedsys]   .Apply[/FONT]
[FONT=Fixedsys] End With[/FONT]
 
[FONT=Fixedsys] MsgBox "Done: " & CStr(iConsolRow - 5) & " entries copied to team worksheet" & Space(10), _[/FONT]
[FONT=Fixedsys]        vbOKOnly + vbInformation, "EU Team Deliverables"[/FONT]
 
[FONT=Fixedsys]End Sub[/FONT]