Use VBA to delete OR highlight rows based on multiple criteria

0
votes

I am trying to create a code that solves the following criteria: If a specific cell in column C equals zero, delete row If a specific cell in column U STARTS with 9, delete row If a specific cell in Column E is a negative value, delete row If a specific cell in column C starts with 2015, highlight color If a specific cell in column C starts with 2016, highlight same color as above If a specific cell in column C starts with 2017, highlight with different color All else, leave

This is what I have so far and I keep getting coding errors. I know this is very specific, any help is greatly appreciated

Sub Module()

Dim x As Long
Dim lastrow As Long
Set sSheetName = ActiveSheet.Name

With Worksheets(sSheetName)
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = lastrow To 1 Step -1
        If Cells(x, 3).Value = 0 Then .EntireRow.Delete
        If Left(Cells(x, 21), 1) = 9 Then .EntireRow.Delete
        If Left(Cells(x, 5), 1) = "-" Then .EntireRow.Delete
        If Left(Cells(x, 3), 4) = 6017 Then
            cell.Offset(, -6).Resize(, 21).Interior.ColorIndex = 39
        If Left(Cells(x, 3), 4) = 6018 Then
            cell.Offset(, -6).Resize(, 21).Interior.ColorIndex = 39
        If Left(Cells(x, 3), 4) = 6150 Then
            cell.Offset(, -6).Resize(, 21).Interior.ColorIndex = 43
        Else
            cell.EntireRow.Interior.ColorIndex = xlNone
    End If

End Sub

2
vbaexcel
Which errors do you get? Use .Cells instead of Cells. Is cell a variable or a typo? – gizlmo
What is wrong with the code? Where specifically does it break down and what error is being displayed? – Scott Craner
What is sSheetName? You haven't defined it. Probably a string - in that case remove the set when assigning the name of the sheet. – FunThomas
Also, within the scope of your With .EntireRow.Delete isn't valid. You need e.g. .Cells(x,3).EntireRow.Delete – Steve Lovell
Compile Error that I am getting: Block If without End If – user8014548

2 Answers

2
votes

Just to sum up all the comments:

Sub Module()

Dim x As Long
Dim lastrow As Long
sSheetName = ActiveSheet.Name

With Worksheets(sSheetName)
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    For x = lastrow To 1 Step -1
        If .Cells(x, 3).Value = 0 Then .Rows(x).Delete
        If Left(.Cells(x, 21), 1) = 9 Then .Rows(x).Delete
        If Left(.Cells(x, 5), 1) = "-" Then .Rows(x).Delete
        If Left(.Cells(x, 3), 4) = 6017 Then
            .Cells(x,1).Resize(, 21).Interior.ColorIndex = 39
        ElseIf Left(.Cells(x, 3), 4) = 6018 Then
            .Cells(x,1).Resize(, 21).Interior.ColorIndex = 39
        ElseIf Left(.Cells(x, 3), 4) = 6150 Then
            .Cells(x,1).Resize(, 21).Interior.ColorIndex = 43
        Else
            .Cells(x,1).EntireRow.Interior.ColorIndex = xlNone
        End If
    Next x
End with
End Sub
0
votes

Refactored code, this should work for you:

Sub tgr()

    Dim rDelete As Range
    Dim rPurple39 As Range
    Dim rGreen43 As Range
    Dim lLastRow As Long
    Dim i As Long

    With ActiveWorkbook.ActiveSheet
        lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("1:" & lLastRow).EntireRow.Interior.ColorIndex = xlNone
        For i = 1 To lLastRow
            If .Cells(i, "C").Value = 0 _
            Or Left(.Cells(i, "U").Value, 1) = 9 _
            Or Left(.Cells(i, "E").Value, 1) = "-" Then
                If rDelete Is Nothing Then Set rDelete = .Rows(i) Else Set rDelete = Union(rDelete, .Rows(i))
            Else
                Select Case Left(.Cells(i, "C"), 4)
                    Case 6017, 6018:    If rPurple39 Is Nothing Then Set rPurple39 = .Cells(i, "A") Else Set rPurple39 = Union(rPurple39, .Cells(i, "A"))
                    Case 6150:          If rGreen43 Is Nothing Then Set rGreen43 = .Cells(i, "A") Else Set rGreen43 = Union(rGreen43, .Cells(i, "A"))
                End Select
            End If
        Next i
    End With

    If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
    If Not rPurple39 Is Nothing Then rPurple39.Interior.ColorIndex = 39
    If Not rGreen43 Is Nothing Then rGreen43.Interior.ColorIndex = 43

End Sub