VBA: how to delete filtered rows (multiple criteria)

[Nelson78]

Hello everybody.

I've the following range:

Dim Rng As Range
    Set Rng = Sheets(1).Range("A1:AM" & lr)

I've to delete all the rows except if, in column F, the cell value is "Milan" or "Berlin" or "London" or "Paris".

How can I figure it out?

Thank's in advance.

 

[Muhammad_Usman]

To delete all the rows in a specific range (e.g., "A1:AM" to "A" & lr) except if the value in column F is "Milan," "Berlin," "London," or "Paris," you can use the following VBA code:

```vba

Sub KeepSpecificCities()
    Dim ws As Worksheet
    Dim lr As Long
    Dim cell As Range
    Dim citiesToKeep As String


    ' Define the worksheet and last row
    Set ws = ThisWorkbook.Sheets(1) ' Change the sheet index as needed
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row


    ' Define the cities to keep (add or remove as needed)
    citiesToKeep = "Milan,Berlin,London,Paris"


    ' Loop through the rows in the range
    For Each cell In ws.Range("F2:F" & lr)
        If InStr(1, citiesToKeep, cell.Value, vbTextCompare) = 0 Then
            ' City is not in the list, delete the entire row
            cell.EntireRow.Delete
            lr = lr - 1 ' Update the last row since a row was deleted
        End If
    Next cell
End Sub

```

Make sure to modify the code according to your specific worksheet index and range as needed. This code will delete all rows where the city in column F is not one of the specified cities ("Milan," "Berlin," "London," or "Paris").

 

[Fluff]

@Muhammad_Usman that looks like it has come from an AI source, please note Rule#17
Not to mention that code will not actually work (unsurprising for something created by AI)

 

[Fluff]

How about

Sub Nelson()
   Dim Ary As Variant, Nary As Variant
   Dim i As Long, c As Long
   Dim Cities As String
   
   Cities = "Milan,Berlin,London,Paris"
   With Sheets(1)
      Ary = .Range("F2:F" & .Range("A" & Rows.Count).End(xlUp)).Value
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   
   For i = 1 To UBound(Ary)
      If InStr(1, Cities, Ary(i, 1), 1) = 0 Then
         Nary(i, 1) = 1
         c = c + 1
      End If
   Next i
   If c = 0 Then
      MsgBox "Nothing to delete"
      Exit Sub
   End If
   With Sheets(1)
      .Range("AN2").Resize(UBound(Ary)).Value = Nary
      With .Range("A2:AN2")
         .Resize(UBound(Ary)).Sort .Range("AN2"), xlAscending, Header:=xlNo
         .Resize(c).EntireRow.Delete
      End With
   End With
End Sub

This assumes that column AN is empty

 

[Nelson78]

How about

Sub Nelson()
   Dim Ary As Variant, Nary As Variant
   Dim i As Long, c As Long
   Dim Cities As String
  
   Cities = "Milan,Berlin,London,Paris"
   With Sheets(1)
      Ary = .Range("F2:F" & .Range("A" & Rows.Count).End(xlUp)).Value
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 1)
  
   For i = 1 To UBound(Ary)
      If InStr(1, Cities, Ary(i, 1), 1) = 0 Then
         Nary(i, 1) = 1
         c = c + 1
      End If
   Next i
   If c = 0 Then
      MsgBox "Nothing to delete"
      Exit Sub
   End If
   With Sheets(1)
      .Range("AN2").Resize(UBound(Ary)).Value = Nary
      With .Range("A2:AN2")
         .Resize(UBound(Ary)).Sort .Range("AN2"), xlAscending, Header:=xlNo
         .Resize(c).EntireRow.Delete
      End With
   End With
End Sub

This assumes that column AN is empty

Very good, with just a small problem (quickly solved by hand, at the moment):

Sometimes, in the city list, I've "FRANKFURT AM MAIN" and "FRANKFURT".
I've to delete "FRANKFURT", but not "FRANKFURT AM MAIN".
Probably the point is in handling

If InStr(1, Cities, Ary(i, 1), 1) = 0 Then

 

[Fluff]

Ok, how about

Sub Nelson()
   Dim Ary As Variant, Nary As Variant
   Dim i As Long, c As Long
   Dim Cities As String
   
   Cities = ",Milan,Berlin,London,Paris,"
   With Sheets(1)
      Ary = .Range("F2:F" & .Range("A" & Rows.Count).End(xlUp).Row).Value
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   
   For i = 1 To UBound(Ary)
      If InStr(1, Cities, "," & Ary(i, 1) & ",", 1) = 0 Then
         Nary(i, 1) = 1
         c = c + 1
      End If
   Next i
   If c = 0 Then
      MsgBox "Nothing to delete"
      Exit Sub
   End If
   With Sheets(1)
      .Range("AN2").Resize(UBound(Ary)).Value = Nary
      With .Range("A2:AN2")
         .Resize(UBound(Ary)).Sort .Range("AN2"), xlAscending, Header:=xlNo
         .Resize(c).EntireRow.Delete
      End With
   End With
End Sub