VBA script delete row containing specific text

A

airfrm

New Member
Joined
Apr 3, 2016
Messages
5
I am very inexperienced with VBA and trying to understand better, but here is my issue. I am currently running the below macro on a workbook. Everything runs good currently, but we are now wanting to delete rows if the cell in column I contains the text COMPL or CMPEB. I have watched many different videos but they all show how to write the code from the start. I am trying to add it to my current code but every time I write it, I keep getting a Compile error: Expected End Sub error. Can anyone please help!!!

Sub DSRConsol_F5()

'Rename the sheet to T-45
ActiveSheet.Name = "T-45 AOG"

'Clear row 1
ActiveSheet.Rows(1).Clear

'Insert two blank rows
Rows(2).Insert Shift:=xlDown
Rows(2).Insert Shift:=xlDown

'Create orange header on the active sheet
ActiveSheet.Activate
With ActiveSheet.Range("B1:K2")
.Merge
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 45
.Value = Format(DateValue(Now), "DD MMM") + " " + ActiveSheet.Name
.Font.Size = 24
.Font.Bold = True
End With



Dim text_length As Integer, x As Integer, y As Integer, lastrow As Integer, lastcol As Integer

Dim InputSheet As String
InputSheet = ActiveSheet.Name

Sheets(InputSheet).Activate


'set column widths
Worksheets(InputSheet).Columns("B:B").ColumnWidth = 60
Worksheets(InputSheet).Columns("C:C").ColumnWidth = 44
Worksheets(InputSheet).Columns("D:D").ColumnWidth = 12
Worksheets(InputSheet).Columns("E:E").ColumnWidth = 18
Worksheets(InputSheet).Columns("F:G").ColumnWidth = 12
Worksheets(InputSheet).Columns("H:H").ColumnWidth = 6
Worksheets(InputSheet).Columns("I:I").ColumnWidth = 12
Worksheets(InputSheet).Columns("J:J").ColumnWidth = 8
Worksheets(InputSheet).Columns("K:K").ColumnWidth = 37


'Establish last row and column counts
lastrow = Worksheets(InputSheet).UsedRange.Rows.Count
lastcol = Worksheets(InputSheet).UsedRange.Columns.Count

'Basic formatting on all rows in the sheet
Worksheets(InputSheet).Range("A:P").VerticalAlignment = xlCenter 'set vert alignment to center
Worksheets(InputSheet).Range("B:P").HorizontalAlignment = xlCenter 'set horizontal alignment to center for now, will adjust Remarks / Nomenclature later
Worksheets(InputSheet).Range("A:P").Font.Name = "Arial" 'set font to Arial
Worksheets(InputSheet).Range("K:K").WrapText = True 'Wrap text on column K, which should be Remarks

'Loop through rows 3+ to format cells
x = 3
Do While x <= lastrow

'align text in cells based on criteria: ignore header rows, xltop alignment for Remarks column of Aircraft, xltop alignment for Gripes
If ActiveSheet.Cells(x, 3) = "TMS" Then 'Modex-BUNO header row

With ActiveSheet.Range("B" & x & ":K" & x) 'set the format for columns B to K of the row
.Interior.Color = RGB(155, 194, 230) 'blue-gray fill
.Font.Size = 11
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With

Range("B" & x).Value = "MODEX-BUNO" 'Add label for "modex-buno" column

ActiveSheet.Rows(x).Insert Shift:=xlDown 'Add a blank row above for the squadron
lastrow = lastrow + 1 'update lastrow so we don't miss rows at the bottom

With ActiveSheet.Range("B" & x & ":K" & x) 'set the format for squadron row
.Interior.Color = RGB(155, 194, 230) 'blue-gray fill
End With

With ActiveSheet.Range("B" & x & ":C" & x) ' merge and center first 2 cells for squadron name
.Merge
.HorizontalAlignment = xlCenter
End With

'populate the squadron name based on Location
If ActiveSheet.Range("I" & (x + 2)) = "NASM" Then
Range("B" & x & ":C" & x).Value = "TW-1"

ElseIf ActiveSheet.Range("I" & (x + 2)) = "NASK" Then
Range("B" & x & ":C" & x).Value = "TW-2"

ElseIf ActiveSheet.Range("I" & (x + 2)) = "NASP" Then
Range("B" & x & ":C" & x).Value = "TW-6"

Else
End If

x = x + 1 'increase x since we just added the row and don't want to repeat adding blank rows

ElseIf ActiveSheet.Cells(x, 3) = "Nomenclature" Then 'Nomenclature header row

With ActiveSheet.Range("C" & x & ":K" & x) 'format for columns B to K of the row
.Interior.Color = RGB(105, 105, 105) 'dark gray fill
.Font.Size = 7
.Font.Color = RGB(255, 255, 255) 'white font
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With

vReturn = Application.Match(Range("L" & x).Value, Worksheets("Yesterday").Range("L:L"), 0)
If IsError(vReturn) Then
Range("B" & x).Value = " "
Else
ActiveSheet.Range("B" & x).Value = Application.Index(Worksheets("Yesterday").Range("B:B"), vReturn)
Worksheets("Yesterday").Range("B" & vReturn).Copy
ActiveSheet.Range("B" & x).PasteSpecial xlPasteAll


End If

ElseIf ActiveSheet.Cells(x, 3) = "T-45" Then 'Aircraft row

With ActiveSheet.Range("C" & x & ":K" & x) 'set the format for columns C to K of the row
.Font.Size = 7
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With

Range("J" & x).NumberFormat = "m/d/yyyy"

If ActiveSheet.Range("I" & x) = "NASM" Then
Range("I" & x).Interior.Color = RGB(254, 216, 117)

ElseIf ActiveSheet.Range("I" & x) = "NASK" Then
Range("I" & x).Interior.Color = RGB(255, 127, 127)

ElseIf ActiveSheet.Range("I" & x) = "NASP" Then
Range("I" & x).Interior.Color = RGB(255, 87, 51)

Else
End If


ElseIf Len(ActiveSheet.Cells(x, 2)) = 0 And (Len(ActiveSheet.Cells(x, 3)) <> 0 Or Len(ActiveSheet.Cells(x, 9)) <> 0) Then 'Gripe row

ActiveSheet.Cells(x, lastcol).HorizontalAlignment = xlLeft 'set horiz alignment for remarks
ActiveSheet.Cells(x, 3).HorizontalAlignment = xlLeft 'nomenclature

'import yesterday's notes
vReturn = Application.Match(Range("L" & x).Value, Worksheets("Yesterday").Range("L:L"), 0)
If IsError(vReturn) Then
Range("B" & x).Value = " "
Else
ActiveSheet.Range("B" & x).Value = Application.Index(Worksheets("Yesterday").Range("B:B"), vReturn)
Worksheets("Yesterday").Range("B" & vReturn).Copy
ActiveSheet.Range("B" & x).PasteSpecial xlPasteAll
ActiveSheet.Range("B" & x).Font.Name = "Arial"
ActiveSheet.Range("B" & x).Font.Size = 11

End If

With ActiveSheet.Range("C" & x & ":K" & x) 'set the format for columns C to K of the row
.Font.Size = 7
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Interior.Color = RGB(211, 211, 211)
End With

If x Mod 2 = 1 Then ' check if row number is odd; alternate the gray fill
ActiveSheet.Range("C" & x & ":K" & x).Interior.Color = RGB(211, 211, 211) ' light gray

ElseIf x Mod 2 <> 1 Then ' check ir row number is even to use other gray fill
ActiveSheet.Range("C" & x & ":K" & x).Interior.Color = RGB(169, 169, 169) ' light gray
End If


Else ' handle any other cases
' do nothing

End If

x = x + 1

Loop


'Hide column A
Columns("A:A").EntireColumn.Hidden = True
Columns("L:L").EntireColumn.Hidden = True

End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Hello @airfrm . Welcome to MrExcel forum.

airfrm said:
delete rows if the cell in column I contains the text COMPL or CMPEB
Click to expand...
Add these lines to the beginning of your macro.
VBA Code: 
  'delete rows if the cell in column I contains the text COMPL or CMPEB
  Application.ScreenUpdating = False
  With ActiveSheet
    .Columns("I").Replace what:="COMPL", replacement:="#N/A", Lookat:=xlWhole
    .Columns("I").Replace what:="CMPEB", replacement:="#N/A", Lookat:=xlWhole
    On Error Resume Next
    .UsedRange.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0
  End With
  Application.ScreenUpdating = True


For example:

Rich (BB code): 
Sub DSRConsol_F5()

  'Rename the sheet to T-45
  ActiveSheet.Name = "T-45 AOG"
  
  'Clear row 1
  ActiveSheet.Rows(1).Clear
  
  'delete rows if the cell in column I contains the text COMPL or CMPEB
  Application.ScreenUpdating = False
  With ActiveSheet
    .Columns("I").Replace what:="COMPL", replacement:="#N/A", Lookat:=xlWhole
    .Columns("I").Replace what:="CMPEB", replacement:="#N/A", Lookat:=xlWhole
    On Error Resume Next
    .UsedRange.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0
  End With
  Application.ScreenUpdating = True
  
  'Insert two blank rows
  Rows(2).Insert Shift:=xlDown
  Rows(2).Insert Shift:=xlDown
  
  'Create orange header on the active sheet
  ActiveSheet.Activate
  With ActiveSheet.Range("B1:K2")
  .Merge
  .HorizontalAlignment = xlCenter
  .Interior.ColorIndex = 45
  .Value = Format(DateValue(Now), "DD MMM") + " " + ActiveSheet.Name
  .Font.Size = 24
  .Font.Bold = True
  End With
  
  
  
  Dim text_length As Integer, x As Integer, y As Integer, lastrow As Integer, lastcol As Integer
  
  Dim InputSheet As String
  InputSheet = ActiveSheet.Name
  
  Sheets(InputSheet).Activate
  
  
  'set column widths
  Worksheets(InputSheet).Columns("B:B").ColumnWidth = 60
  Worksheets(InputSheet).Columns("C:C").ColumnWidth = 44
  Worksheets(InputSheet).Columns("D:D").ColumnWidth = 12
  Worksheets(InputSheet).Columns("E:E").ColumnWidth = 18
  Worksheets(InputSheet).Columns("F:G").ColumnWidth = 12
  Worksheets(InputSheet).Columns("H:H").ColumnWidth = 6
  Worksheets(InputSheet).Columns("I:I").ColumnWidth = 12
  Worksheets(InputSheet).Columns("J:J").ColumnWidth = 8
  Worksheets(InputSheet).Columns("K:K").ColumnWidth = 37
  
  
  'Establish last row and column counts
  lastrow = Worksheets(InputSheet).UsedRange.Rows.Count
  lastcol = Worksheets(InputSheet).UsedRange.Columns.Count
  
  'Basic formatting on all rows in the sheet
  Worksheets(InputSheet).Range("A:P").VerticalAlignment = xlCenter 'set vert alignment to center
  Worksheets(InputSheet).Range("B:P").HorizontalAlignment = xlCenter 'set horizontal alignment to center for now, will adjust Remarks / Nomenclature later
  Worksheets(InputSheet).Range("A:P").Font.Name = "Arial" 'set font to Arial
  Worksheets(InputSheet).Range("K:K").WrapText = True 'Wrap text on column K, which should be Remarks
  
  'Loop through rows 3+ to format cells
  x = 3
  Do While x <= lastrow
  
  'align text in cells based on criteria: ignore header rows, xltop alignment for Remarks column of Aircraft, xltop alignment for Gripes
  If ActiveSheet.Cells(x, 3) = "TMS" Then 'Modex-BUNO header row
  
  With ActiveSheet.Range("B" & x & ":K" & x) 'set the format for columns B to K of the row
  .Interior.Color = RGB(155, 194, 230) 'blue-gray fill
  .Font.Size = 11
  .Font.Bold = True
  .Borders.LineStyle = xlContinuous
  .Borders.Weight = xlThin
  End With
  
  Range("B" & x).Value = "MODEX-BUNO" 'Add label for "modex-buno" column
  
  ActiveSheet.Rows(x).Insert Shift:=xlDown 'Add a blank row above for the squadron
  lastrow = lastrow + 1 'update lastrow so we don't miss rows at the bottom
  
  With ActiveSheet.Range("B" & x & ":K" & x) 'set the format for squadron row
  .Interior.Color = RGB(155, 194, 230) 'blue-gray fill
  End With
  
  With ActiveSheet.Range("B" & x & ":C" & x) ' merge and center first 2 cells for squadron name
  .Merge
  .HorizontalAlignment = xlCenter
  End With
  
  'populate the squadron name based on Location
  If ActiveSheet.Range("I" & (x + 2)) = "NASM" Then
  Range("B" & x & ":C" & x).Value = "TW-1"
  
  ElseIf ActiveSheet.Range("I" & (x + 2)) = "NASK" Then
  Range("B" & x & ":C" & x).Value = "TW-2"
  
  ElseIf ActiveSheet.Range("I" & (x + 2)) = "NASP" Then
  Range("B" & x & ":C" & x).Value = "TW-6"
  
  Else
  End If
  
  x = x + 1 'increase x since we just added the row and don't want to repeat adding blank rows
  
  ElseIf ActiveSheet.Cells(x, 3) = "Nomenclature" Then 'Nomenclature header row
  
  With ActiveSheet.Range("C" & x & ":K" & x) 'format for columns B to K of the row
  .Interior.Color = RGB(105, 105, 105) 'dark gray fill
  .Font.Size = 7
  .Font.Color = RGB(255, 255, 255) 'white font
  .Font.Bold = True
  .Borders.LineStyle = xlContinuous
  .Borders.Weight = xlThin
  End With
  
  vReturn = Application.Match(Range("L" & x).Value, Worksheets("Yesterday").Range("L:L"), 0)
  If IsError(vReturn) Then
  Range("B" & x).Value = " "
  Else
  ActiveSheet.Range("B" & x).Value = Application.Index(Worksheets("Yesterday").Range("B:B"), vReturn)
  Worksheets("Yesterday").Range("B" & vReturn).Copy
  ActiveSheet.Range("B" & x).PasteSpecial xlPasteAll
  
  
  End If
  
  ElseIf ActiveSheet.Cells(x, 3) = "T-45" Then 'Aircraft row
  
  With ActiveSheet.Range("C" & x & ":K" & x) 'set the format for columns C to K of the row
  .Font.Size = 7
  .Borders.LineStyle = xlContinuous
  .Borders.Weight = xlThin
  End With
  
  Range("J" & x).NumberFormat = "m/d/yyyy"
  
  If ActiveSheet.Range("I" & x) = "NASM" Then
  Range("I" & x).Interior.Color = RGB(254, 216, 117)
  
  ElseIf ActiveSheet.Range("I" & x) = "NASK" Then
  Range("I" & x).Interior.Color = RGB(255, 127, 127)
  
  ElseIf ActiveSheet.Range("I" & x) = "NASP" Then
  Range("I" & x).Interior.Color = RGB(255, 87, 51)
  
  Else
  End If
  
  
  ElseIf Len(ActiveSheet.Cells(x, 2)) = 0 And (Len(ActiveSheet.Cells(x, 3)) <> 0 Or Len(ActiveSheet.Cells(x, 9)) <> 0) Then 'Gripe row
  
  ActiveSheet.Cells(x, lastcol).HorizontalAlignment = xlLeft 'set horiz alignment for remarks
  ActiveSheet.Cells(x, 3).HorizontalAlignment = xlLeft 'nomenclature
  
  'import yesterday's notes
  vReturn = Application.Match(Range("L" & x).Value, Worksheets("Yesterday").Range("L:L"), 0)
  If IsError(vReturn) Then
  Range("B" & x).Value = " "
  Else
  ActiveSheet.Range("B" & x).Value = Application.Index(Worksheets("Yesterday").Range("B:B"), vReturn)
  Worksheets("Yesterday").Range("B" & vReturn).Copy
  ActiveSheet.Range("B" & x).PasteSpecial xlPasteAll
  ActiveSheet.Range("B" & x).Font.Name = "Arial"
  ActiveSheet.Range("B" & x).Font.Size = 11
  
  End If
  
  With ActiveSheet.Range("C" & x & ":K" & x) 'set the format for columns C to K of the row
  .Font.Size = 7
  .Borders.LineStyle = xlContinuous
  .Borders.Weight = xlThin
  .Interior.Color = RGB(211, 211, 211)
  End With
  
  If x Mod 2 = 1 Then ' check if row number is odd; alternate the gray fill
  ActiveSheet.Range("C" & x & ":K" & x).Interior.Color = RGB(211, 211, 211) ' light gray
  
  ElseIf x Mod 2 <> 1 Then ' check ir row number is even to use other gray fill
  ActiveSheet.Range("C" & x & ":K" & x).Interior.Color = RGB(169, 169, 169) ' light gray
  End If
  
  
  Else ' handle any other cases
  ' do nothing
  
  End If
  
  x = x + 1
  
  Loop
  
  
  'Hide column A
  Columns("A:A").EntireColumn.Hidden = True
  Columns("L:L").EntireColumn.Hidden = True

End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
macro help, copying font and color
Replies
1
Views
384
sijpie
sijpie
M
  • Question Question
Please help me to correct Excel VBA code!
Replies
1
Views
335
Minh Tuan VN
M
M
  • Solved
vba to sum up each column for each employee on column (A)
Replies
6
Views
314
kvsrinivasamurthy
K
F
  • Solved
Web search using Excel VBA error and script corrections
2
Replies
10
Views
184
Edgar_
Edgar_
T
  • Solved
VBA
Replies
6
Views
380
twildone
T

Forum statistics

Threads
1,223,958
Messages
6,175,633
Members
452,661
Latest member
Nonhle

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top