Delete Row based on cell value through multiple worksheets

**jgrant1** · 08-08-2012, 07:46 AM

Hi,

I have used a Macro that looks at the values in a certain column and deletes the row if it meets the specified criteria, in this instance it is any grade that is an F or higher, code below.

Sub Del_Seniors()
    Range("P5").Select
    Do Until ActiveCell.Value = ""
        If ActiveCell.Value > "F" Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Loop
End Sub

The macro works which is great. However, the workbook I am working on has multiple worksheets which also need to be checked using the same rules but the column order varies. For example, in Sheet1 the data is in column 16, in Sheet2 the data is in column 10....each column has the same heading.

Is there a way of identifying which column holds the relevant data, select it and then run the above VBA?

Any help would be greatly appreciated.

**JBeaucaire** · 08-08-2012, 11:32 AM

Perhaps. How would the macro determine it should use column 16 on sheet1, column 10 on sheet2, etc?

**jgrant1** · 08-08-2012, 11:38 AM

That's another piece of the puzzle....Each Column will have the same Heading so is there a way of scanning the row with the column headings, identifying the one we want, "Grade Level", and then performing the deletion macro?

Thanks

**Pichingualas** · 08-08-2012, 12:43 PM

This should do what you want:

Sub Del_Seniors()
    Dim ws As Worksheet
    Dim col As Integer
    Dim lrow As Long
    Dim crow As Long
    
    For Each ws In Worksheets
        col = 1
        Do While col < ws.Columns.Count
            If ws.Cells(1, col).Value = "Grade Level" Then
                Exit Do
            Else
                col = col + 1
            End If
        Loop
        
        If col = ws.Columns.Count Then
            MsgBox "Grade level column not found on sheet " & ws.Name & ".", vbOKOnly, "Del_Seniors"
            GoTo NextWs
        End If
        
        lrow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
        
        crow = 2
        
        Do While crow <= lrow
            If ws.Cells(crow, col).Value > "F" Then
                ws.Cells(crow, col).EntireRow.Delete
                lrow = lrow - 1
            Else
                crow = crow + 1
            End If
        Loop
NextWs:
    Next ws
End Sub

I assumed that your headings are located on row 1 and your data starts on row 2 of each sheet. It can be changed if that's not the case. I hope that helps.

**JBeaucaire** · 08-08-2012, 03:19 PM

This should be a but faster overall since it only deletes once on each sheet, deleting all the found rows at the same time. Also, it will only evaluate cells in the Grade Level column that have an entry in them, even if there are blanks in the middle of the dataset, it will get them all.

Option Explicit

Sub Del_Seniors()
Dim ws As Worksheet, col As Long
Dim delRNG As Range, cell As Range

    On Error Resume Next
    For Each ws In Worksheets
        col = ws.Rows(1).Find("Grade Level", LookIn:=xlValues, LookAt:=xlPart).Column
        If col > 0 Then
            For Each cell In ws.Columns(col).SpecialCells(xlConstants)   'or xlFormulas
                If cell > "F" Then
                    If delRNG Is Nothing Then
                        Set delRNG = cell
                    Else
                        Set delRNG = Union(delRNG, cell)
                    End If
                End If
            Next cell
            If Not delRNG Is Nothing Then
                delRNG.EntireRow.Delete xlShiftUp
                Set delRNG = Nothing
            End If
        Else
            MsgBox "Grade level column not found on sheet " & ws.Name & ".", vbOKOnly, "Del_Seniors"
        End If
    Next ws

End Sub