Filter Sheet and combine simelar rows with a matching cell

[JCHuysamer]

Hi Guys

Thanks for all the help - But now I sit with my most DIFFICULT problem yet and I don't even know where to start:

I have 2 workbooks (Active Projects, VMC Display)

WB - Active Projects

Date	Project Number	Audit	JTO	PTO
15/01/16	P-6200123	1
15/01/16	P-6200555		1
16/01/16	P-6200123		1	1
18/01/16	P-6200612	4		1
19/01/16	P-6200123	1		1

<tbody>
</tbody>

I need to filter the WB "Active Projects" first by date(to specify a specific period - either a week, day or month - this part I can do) and then I need to combine rows with matching Project Numbers (column B)(Combine all duplicates - as per below in red - Dates does not have to display ) and display them on WB "VMC Display" (only displaying the selected criteria/date range on WB "Active Projects")


WB - VMC Display

Date	Project Number	Audit	JTO	PTO
	P-6200123	2	1	2
	P-6200555		1
	P-6200612<strike></strike>	4		1
-----.......

<tbody>
</tbody>

Is this at all POSSIBLE????????

 

[JCHuysamer]

If anyone is at all interested i got it figured out - it is working over 4 WB (Data Calc 1, 2, 3 & 4 - 1 WB for every filter) - it can be done on 1 WB but that will just make the code more difficult for a novice like me

' Filter for the week
Dim ws As Worksheet

Sheets("VMC").Select
Range("B2:B300").Select
Selection.Delete Shift:=xlUp

Sheets("Projects").Visible = True
Sheets("Projects").Select
Cells.Select
Selection.AutoFilter
lastrow = ActiveSheet.Cells(Rows.Count, "a").End(xlUp).Row + 1


Cells.Select
Selection.AutoFilter
'Filter By Week
ActiveSheet.Range("A2:A" & lastrow).AutoFilter Field:=1, Criteria1:= _
xlFilterThisWeek, Operator:=xlFilterDynamic
'Select, Copy & paste Filterd Data to "Data Calc 1"
ActiveSheet.Range("a2:ap" & lastrow).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Data Calc 1").Visible = True
Sheets("Data Calc 1").Select
Range("A1").Select
ActiveSheet.Paste

'Remove copied data from Data Calc 1
Whoa:
Sheets("Data Calc 1").Select

'Filter by Project Number
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("A1:AP29").AutoFilter Field:=2, Criteria1:=Range("B1").Value
'Select, Copy & paste Filterd Data to "Data Calc 2"
ActiveSheet.Range("a1:ap29").SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Data Calc 2").Visible = True
Sheets("Data Calc 2").Select
Range("A1").Select
ActiveSheet.Paste

'Filter by COW
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("A1:AP29").AutoFilter Field:=6, Criteria1:=Range("f1").Value
'Select, Copy & paste Filterd Data to "Data Calc 3"
ActiveSheet.Range("a1:ap29").SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Data Calc 3").Visible = True
Sheets("Data Calc 3").Select
Range("A1").Select
ActiveSheet.Paste

'Filter by Contractor
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("A1:AP29").AutoFilter Field:=13, Criteria1:=Range("m1").Value
'Select, Copy & paste Filterd Data to "Data Calc 4"
ActiveSheet.Range("a1:ap29").SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Data Calc 4").Visible = True
Sheets("Data Calc 4").Select
Range("A1").Select
ActiveSheet.Paste

'Copy data to VMC
Sheets("Data Calc 4").Select
Rows("30:30").Select
Selection.Copy
Sheets("VMC").Select
lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
Range("A" & lastrow).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Remove copied data from Data Calc 1
Sheets("Data Calc 1").Visible = True
Sheets("Data Calc 1").Select
ActiveSheet.Range("A1:AP29").AutoFilter Field:=2, Criteria1:=Range("B1").Value
ActiveSheet.Range("A1:AP29").AutoFilter Field:=6, Criteria1:=Range("f1").Value
ActiveSheet.Range("A1:AP29").AutoFilter Field:=13, Criteria1:=Range("m1").Value
ActiveSheet.Range("a1:ap29").SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Sheets("VMC").Select
Sheets("Data Calc 4").Select
Selection.AutoFilter
Rows("1:29").Select
Selection.ClearContents
Sheets("Data Calc 3").Select
Selection.AutoFilter
Rows("1:29").Select
Selection.ClearContents
Sheets("Data Calc 2").Select
Selection.AutoFilter
Rows("1:29").Select
Selection.ClearContents

'Verify if filter should run again
Sheets("Data Calc 1").Select
Range("b1").Select
If Range("b1").Value = "" Then GoTo WhoopWhoop

GoTo Whoa

WhoopWhoop:
Sheets("VMC").Select

End Sub