Consulting

Results 1 to 11 of 11

Thread: Deleting rows with specific text

  1. #1

    Deleting rows with specific text

    I am looking for VBA code that will delete rows not containing the word "profile" and those not containing the word "advanced". Besides I would like to keep blank rows that come every 9th row. (row 9, 18, 27 etc must be kept blank).

    Thanks

  2. #2
    VBAX Mentor Logit's Avatar
    Joined
    Sep 2016
    Posts
    338
    Location
    .
    This is one method :

    Option Explicit
    
    
    Sub RwDel()
    
    
    Dim x As Long, trm As String, trm2 As String
    
    
    trm = "profile"
    trm2 = "advanced"
    
    
    With Sheets("Sheet1")    '<~~~ edit Sheet as required
        For x = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
            If Not Rows(x).Find(trm) Is Nothing Or Not Rows(x).Find(trm2) Is Nothing Then Rows(x).Delete
        Next x
    End With
    
    
    End Sub

  3. #3

    'Deleting rows with specific text'

    Hi Logit, Thanks for your reply. The code is deleting the rows with "advanced" and keeping the blank rows as required, but unfortunatelly it is also deleting the rows with the text "profile" which are needed.

    Can you please amend to make it work as needed.


    Thanks again.



    Quote Originally Posted by Logit View Post
    .
    This is one method :

    Option Explicit
    
    
    Sub RwDel()
    
    
    Dim x As Long, trm As String, trm2 As String
    
    
    trm = "profile"
    trm2 = "advanced"
    
    
    With Sheets("Sheet1")    '<~~~ edit Sheet as required
        For x = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
            If Not Rows(x).Find(trm) Is Nothing Or Not Rows(x).Find(trm2) Is Nothing Then Rows(x).Delete
        Next x
    End With
    
    
    End Sub

  4. #4
    VBAX Mentor Logit's Avatar
    Joined
    Sep 2016
    Posts
    338
    Location
    .
    Sub RwDel2()
    
    
    
    
    Dim x As Long, trm As String, trm2 As String
    
    
    
    
    trm = "profile"
    
    
    
    
    With Sheets("Sheet1")    '<~~~ edit Sheet as required
        For x = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
            If Not Rows(x).Find(trm2) Is Nothing Then Rows(x).Delete
        Next x
    End With
    
    
    
    
    End Sub

  5. #5
    Hi Logit,

    Thanks very much, this code worked for me although there was trm2 = "advanced" missing which I added myself.

    Thanks again.


    Quote Originally Posted by Logit View Post
    .
    Sub RwDel2()
    
    
    
    
    Dim x As Long, trm As String, trm2 As String
    
    
    
    
    trm = "profile"
    
    
    
    
    With Sheets("Sheet1")    '<~~~ edit Sheet as required
        For x = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
            If Not Rows(x).Find(trm2) Is Nothing Then Rows(x).Delete
        Next x
    End With
    
    
    
    
    End Sub

  6. #6
    VBAX Mentor Logit's Avatar
    Joined
    Sep 2016
    Posts
    338
    Location
    .
    You are welcome. Apologies for the oversight. Im doing more of that lately. My old mind and eyes are not working together.

    Need to locate the fountain of youth.

  7. #7
    Quote Originally Posted by Logit View Post
    .
    You are welcome. Apologies for the oversight. Im doing more of that lately. My old mind and eyes are not working together.

    Need to locate the fountain of youth.

  8. #8
    Hi Logit, it's me again, may I ask you one more favour. Can you please edit the code to do the opposite as I may need this scenario as well that is the code is to keep the rows with "profile" and "advanced" and the blank lines every 9th row and remove all the other rows

  9. #9
    Another way to approach it, using autofilter

    'Assumes the first row contains column labels
    Sub KeepProfileAdvanced()
        Dim WS As Worksheet
        Dim FilterRange As Range
        Dim DataRange As Range
        Dim DeleteRange As Range
        Dim I As Long, LR As Long
    
        Set WS = ActiveSheet
    
        With WS
            Set FilterRange = .Range(.Range("A1"), .Cells(.Rows.Count, "A").End(xlUp))
            Set DataRange = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    
            If WS.AutoFilterMode Then
                WS.AutoFilterMode = False
            End If
        End With
    
        Application.ScreenUpdating = False
        FilterRange.AutoFilter Field:=1, Criteria1:="<>profile", Operator:=xlAnd, Criteria2:="<>advanced"
        Set DeleteRange = Application.Intersect(FilterRange.SpecialCells(xlCellTypeVisible).EntireRow, DataRange.EntireRow)
    
        If WS.AutoFilterMode Then
            WS.AutoFilterMode = False
        End If
    
        If Not DeleteRange Is Nothing Then
            DeleteRange.Delete                            'delete rows
            'Add blank lines
            With DataRange
                LR = .Rows.Count
                For I = 1 To LR
                    If I Mod 9 = 0 Then
                        .Cells(I, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        LR = LR + 1
                    End If
                Next I
            End With
        End If
    
        Application.ScreenUpdating = True
    End Sub

  10. #10
    Thanks for the code but this does not work for me as it almost deleted everything including the rows which I want to keep.




    Quote Originally Posted by rlv View Post
    Another way to approach it, using autofilter

    'Assumes the first row contains column labels
    Sub KeepProfileAdvanced()
        Dim WS As Worksheet
        Dim FilterRange As Range
        Dim DataRange As Range
        Dim DeleteRange As Range
        Dim I As Long, LR As Long
    
        Set WS = ActiveSheet
    
        With WS
            Set FilterRange = .Range(.Range("A1"), .Cells(.Rows.Count, "A").End(xlUp))
            Set DataRange = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    
            If WS.AutoFilterMode Then
                WS.AutoFilterMode = False
            End If
        End With
    
        Application.ScreenUpdating = False
        FilterRange.AutoFilter Field:=1, Criteria1:="<>profile", Operator:=xlAnd, Criteria2:="<>advanced"
        Set DeleteRange = Application.Intersect(FilterRange.SpecialCells(xlCellTypeVisible).EntireRow, DataRange.EntireRow)
    
        If WS.AutoFilterMode Then
            WS.AutoFilterMode = False
        End If
    
        If Not DeleteRange Is Nothing Then
            DeleteRange.Delete                            'delete rows
            'Add blank lines
            With DataRange
                LR = .Rows.Count
                For I = 1 To LR
                    If I Mod 9 = 0 Then
                        .Cells(I, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        LR = LR + 1
                    End If
                Next I
            End With
        End If
    
        Application.ScreenUpdating = True
    End Sub

  11. #11
    Quote Originally Posted by gauca001 View Post
    Thanks for the code but this does not work for me as it almost deleted everything including the rows which I want to keep.
    Well it's an example, not a tailored solution.
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •