Deleting blocks of rows (same first column entry) according to multiple criteria using VBA

[fxrexcel]

I have the following data and the desired outcome, see below. I have about 100,000 entries. I will a loop with VBA that does the following:

• If a company contains in column 2 either of the following PE, M&A, Debt (these are actually many more, I have a list of what to exclude), then delete all rows of that company
• If a company's column 2 entries do not contain any PE, M&A, Debt, then do not delete this company from the list
• E.g.:
  • Company 1 contains a PE, M&A deal --- hence all 5 rows of Company 1 need to be deleted
  • Company 2 does not contain any of PE, M&A, Debt deals --- hence keep all rows of Company 2

Data:

Name | Deal

Company 1 PE
Company 1 M&A
Company 1 Seed
Company 1 Seed
Company 1 Angel
Company 2 Seed
Company 2 -
Company 2 Seed
Company 3 Debt
Company 4 Angel
Company 4 -
Company 4 Angel
Company 4 Seed
... ...
... ...
... ...


Outcome:

Name | Deal

Company 2 Seed
Company 2 -
Company 2 Seed
Company 4 Angel
Company 4 -
Company 4 Angel
Company 4 Seed
... ...
... ...
... ...


Thanks a lot for your help!

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub DeleteRowsWith_PE_MA_Debt_Etc()
  Dim R As Long, LastRow As Long, V As Variant, DeleteMe() As String
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  DeleteMe = Split("[B][COLOR="#FF0000"]PE,M&A,Debt[/COLOR][/B]", ",")
  For Each V In DeleteMe
    Columns("B").Replace Trim(V), "#N/A", xlWhole, , False, , False, False
  Next
  On Error Resume Next
  For R = LastRow To 1 Step -1
    If IsError(Cells(R, "B").Value) Then Columns("A").Replace Cells(R, "A").Value, "#N/A", xlWhole, , False, , False, False
  Next
  Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  On Error GoTo 0
End Sub[/td]
[/tr]
[/table]

Put your list of values that mark companies to be deleted as a comma separated list where I have marked in red above. If your list it huge, then it should be placed in a range of cells and you should tell us the name of the sheet and the starting cell address for that list.

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...according-to-multiple-criteria-using-vba.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[Fluff]

Another option

Sub DeleteRws()
   Dim Cl As Range
   Dim Ary As Variant
   
   Ary = Array("PE", "M&A", "Debt")
   Range("A1:B1").AutoFilter 2, Ary, xlFilterValues
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
         .Item(Cl.Value) = Empty
      Next Cl
      Range("A1:B1").AutoFilter 2
      Range("A1:B1").AutoFilter 1, .keys, xlFilterValues
      ActiveSheet.AutoFilter.Range.Offset(1).EntireRow.Delete
   End With
   ActiveSheet.AutoFilterMode = False
End Sub

 

[fxrexcel]

Hi Rick,

wow, thanks. Works really well so far.

Now, imagine I need to extend this to multiple columns.

The criteria above is the same, but now I am adding the following 2 columns:

Region (only "Europe", "Americas")
Industry (only "Construction", "FMCG", "Finance")


Data:

Name | Deal | Region | Industry | ... | ...

Company 1 PE Europe Automotive
Company 1 M&A Europe Automotive
Company 1 Seed Europe Automotive
Company 1 Seed Europe Automotive
Company 1 Angel Europe Automotive
Company 2 Seed Europe Construction
Company 2 - Europe Construction
Company 2 Seed Europe Construction
Company 3 Debt Europe Healthcare
Company 4 Angel Asia Healthcare
Company 4 - Asia Healthcare
Company 4 Angel Asia Healthcare
Company 4 Seed Asia Healthcare
... ...
... ...
... ...


Outcome:

Name | Deal | Region | Industry | ... | ...Company 2 Seed EuropeConstruction
Company 2 - EuropeConstruction
Company 2 Seed EuropeConstruction
... ...
... ...
... ...

Thank you!