How to remove rows based on filters?

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.

I'd skip VBA and just use a pivot table

Attachment 26869

Quote:

---

Originally Posted by Paul_Hossler

I'd skip VBA and just use a pivot table

Attachment 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.

Can you show how your end result will look like?

Quote:

---

Originally Posted by BIFanatic

Can you show how your end result will look like?

---

Yes, have a look to this file:

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


Attachment 26873


A pivot table could do all that (and more)

Attachment 26874

Quote:

---

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

Code:

---

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

---