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