How to remove rows based on filters?

[fa2020]

Hi everybody,
I have provided an example excel sheet which is just for testing. I'll try to expand it to my real world problem (my real world problem has thousands of rows). I want to filter my row based on Type C and create a list which contains sum of work time for each date.
Please add some note between your code an explain each step (I'm new to VBA)
Thanks.

[Paul_Hossler]

I'd skip VBA and just use a pivot table

26869

[fa2020]

I'd skip VBA and just use a pivot table

26869
No, I need to work with VBA. I revised my file. I need to filter based on Type C and then list sum of working time for each date and each person.

[BIFanatic]

Can you show how your end result will look like?

[fa2020]

Can you show how your end result will look like?
Yes, have a look to this file:

[Paul_Hossler]

Your desired result is confusing. Looks like you have more that just Type = C entries.


26873


A pivot table could do all that (and more)

26874



No, I need to work with VBA. I revised my file. I need to filter based on Type C and then list sum of working time for each date and each person.

Need or Want? VBA is fun and can do what (I think) you want



Option Explicit


Sub FilterMyData()
Dim r As Long, r1 As Long
Dim rOut As Range, rOut1 As Range

r1 = 2

Application.ScreenUpdating = False

With ActiveSheet
For r = 2 To .Cells(1, 1).CurrentRegion.Rows.Count
If .Cells(r, 4).Value = "C" Then
.Cells(r1, 14).Value = .Cells(r, 7).Value
.Cells(r1, 15).Value = .Cells(r, 8).Value
.Cells(r1, 16).Value = .Cells(r, 9).Value
r1 = r1 + 1
End If
Next r

Set rOut = .Cells(1, 14).CurrentRegion
Set rOut1 = rOut.Cells(2, 1).Resize(rOut.Rows.Count - 1, rOut.Columns.Count)


With .Sort
.SortFields.Clear
.SortFields.Add Key:=rOut1.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rOut1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rOut
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

With rOut
For r = .Rows.Count To 2 Step -1
If .Cells(r, 1).Value = .Cells(r - 1, 1).Value And .Cells(r, 2).Value = .Cells(r - 1, 2).Value Then
.Cells(r - 1, 3).Value = .Cells(r - 1, 3).Value + .Cells(r, 3).Value
.Rows(r).Delete
End If
Next r
End With


rOut.EntireColumn.AutoFit


Application.ScreenUpdating = True
End Sub