Delete rows in data where column B doesn't meet criteria

Hi,

In the attached example, I have a list of Basketball matches in column B and what I want to do is reduce the list (by deleting unwanted rows, not filtering) to matches that just contain NBA matches. The full version of my data will contain thousands of rows so you can imagine this will save me a lot of hard work not manually go through each row.

In the worksheet 'Team List', I have a list of the team names to verify which matches to keep. Basically, any row in column B that does not contain a team name from my 'Team List' wants to be deleted. There is a couple of teams that look like duplicates in my team list but that's because they have been spelt slightly differently in the original data set. Therefore, it is right to keep both spelling of Cleveland Cavaliers in the Team List.

Any help, much appreciated.

Cheers,
Adam.

Hi Sintek,

Thanks for your reply. In answer to your question, both of the teams names in the fixture name in column B, must be present in the 'Team List'.

I'm not sure if you have accounted for this in your code but when I just tried to run the code, it didn't seem to remove any rows at all.

adam2308

Try this one.
Should be very fast.

Sub test()
    Dim rng As Range, temp, myRng As Range
    With Sheets("team list")
        With .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            temp = .Value
            With .Offset(, 2).Cells(1).Resize(, .Rows.Count)
                .Value = Application.Transpose(temp)
                Sheets("marketing stats").Range("b1").Copy .Offset(-1)
                .Value = .Parent.Evaluate("""<>*""&" & .Address & "&""*""")
                Set rng = .Offset(-1).Resize(2)
            End With
        End With
    End With
    With Sheets("marketing stats").Cells(1).CurrentRegion
        .AdvancedFilter 1, rng
        .Offset(1).EntireRow.Delete
        .Parent.ShowAllData
    End With
    Sheets("team list").[c1].CurrentRegion.Clear
End Sub

perfect jindon - very clever!

One thing I didn't pick up on is I would also need to delete the rows that have "(Specials)" within the fixture name? Any chance we can add a bit more code to deal with this?

Thanks.

Try change to

Sub test()
    Dim rng As Range, temp, myRng As Range
    With Sheets("team list")
        With .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            temp = .Value
            With .Offset(, 2).Cells(1).Resize(, .Rows.Count)
                .Value = Application.Transpose(temp)
                Sheets("marketing stats").Range("b1").Copy .Offset(-1)
                .Value = .Parent.Evaluate("""<>*""&" & .Address & "&""*""")
                .Cells(2, 1).Value = "*(Specials)*"
                Set rng = .CurrentRegion
            End With
        End With
    End With
    With Sheets("marketing stats").Cells(1).CurrentRegion
        .AdvancedFilter 1, rng
        .Offset(1).EntireRow.Delete
        .Parent.ShowAllData
    End With
    Sheets("team list").[c1].CurrentRegion.Clear
End Sub