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

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Date
[/TD]
[TD]Project Number
[/TD]
[TD]Audit
[/TD]
[TD]JTO
[/TD]
[TD]PTO
[/TD]
[/TR]
[TR]
[TD]15/01/16
[/TD]
[TD]P-6200123
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]15/01/16
[/TD]
[TD]P-6200555
[/TD]
[TD][/TD]
[TD]1
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16/01/16
[/TD]
[TD]P-6200123
[/TD]
[TD][/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]18/01/16
[/TD]
[TD]P-6200612
[/TD]
[TD]4
[/TD]
[TD][/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]19/01/16
[/TD]
[TD]P-6200123
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD]1
[/TD]
[/TR]
</tbody>[/TABLE]











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
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Date
[/TD]
[TD]Project Number
[/TD]
[TD]Audit
[/TD]
[TD]JTO
[/TD]
[TD]PTO
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]P-6200123
[/TD]
[TD]2
[/TD]
[TD]1
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]P-6200555
[/TD]
[TD][/TD]
[TD]1
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]P-6200612<strike></strike>
[/TD]
[TD]4
[/TD]
[TD][/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]-----.......
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]











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