Deleting specific rows according to the cell value and column heading

Question

Below is the code I wrote, which deletes the rows that contain the value "PRODUCTION" in column M

Sub DeleteProducts()

    Dim LR, i As Long
    Dim RNG As Range
    Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Sheets
        LR = ws.Cells(Rows.Count, "M").End(xlUp).Row

        For i = LR To 2 Step -1
            Select
                Case ws.Cells(i, "M").Value
                Case Is <> "Production"
                ws.Cells(i, "M").EntireRow.Delete shift:=xlUp
            End Select
        Next i
    Next ws

End Sub

I need rows to be deleted in multiple sheets according to the column header because column name may change ( M to something else) but the header will be the same in every sheet.

Answer 1

I assume that the header of the column is in the first row of each worksheet:

Sub DeleteProducts()

Dim LR as Long, LC as Long, i As Long, j As Long
Dim RNG As Range
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets

    LC = ws.Cells(1, Columns.Count).End(xlToRight).Column
    For i = LC To 2 Step -1
        If ws.Cells(1, i) = "YOURnameHERE" Then
            LR = ws.Cells(Rows.Count, i).End(xlUp).Row
            Exit For
        End If
    Next

    For j = LR To 2 Step -1
        If ws.Cells(j, i).Value <> "Production" Then ws.Cells(j, i).EntireRow.Delete shift:=xlUp
    Next

Next ws

End Sub

This will find the name of the column, and then store in i that column's number. With that information you can then find the last row of that very column, and look for every value that is not = "Production".

I also corrected some other bits of code, just for it to be cleaner.

Answer 2

Please use Range.Find to find the target column. Modified your code below.

Sub DeleteProducts()

Dim LR, i As Long
Dim RNG As Range
Dim ws As Worksheet
Dim rngTargetColumn as range


For Each ws In ActiveWorkbook.Sheets
    Set rngTargetColumn = ws.Range("1:1").Find("*<Column Heading>*") 'Replace <Column Heading> with your column  header string
    if not rngTargetColumn is Nothing then
        LR = ws.Cells(Rows.Count, rngTargetColumn.Column).End(xlUp).Row

        For i = LR To 2 Step -1
            If ws.Cells(i, rngTargetColumn.Column).Value <> "Production" Then
                    ws.Cells(i, rngTargetColumn.Column).EntireRow.Delete shift:=xlUp
            End If
        Next i
        Set rngTargetColumn = Nothing
    End If
Next ws
End Sub

Answer 3

Her is my shot at the task. The code searches for the desired header in the first row on all sheets. If the header is found, the search for "Production" continues in the column in witch the header was found.

EDIT: Did some minor cleanup of the code.

Sub DeleteRowProduction()

Dim Header As Range
Dim FoundCell As Range
Dim ws As Worksheet
Dim HeaderToFind As String
Dim ValueToFind As String

HeaderToFind = "aaa"
ValueToFind = "Production"

For Each ws In Worksheets

    Set Header = ws.Rows(1).Find(what:=HeaderToFind, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)

    If Not Header Is Nothing Then

        Set FoundCell = ws.Columns(Header.Column).Find(what:=ValueToFind, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)

        Do While Not FoundCell Is Nothing
            ws.Rows(FoundCell.Row).Delete
            Set FoundCell = Nothing
            Set FoundCell = ws.Columns(Header.Column).Find(what:=ValueToFind, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
        Loop

    End If

Next ws

End Sub