Find rows to delete with a macro based on cell content

I've written a macro to create 2 worksheets containing data from a 3rd worksheet. My macro works fine, but it's "stupid". I manually selected rows on new worksheet for deletion. I can't figure out a way to have the macro delete the rows based on the contents of the cell in column A. How can I have the macro automatically determine which rows to delete? I've attached a copy of the spreadsheet with dummy data so you can see what I'm trying to do. I can't use a formula to do this because it won't pick up the background color formatting. Also, each entry on the first sheet could have anywhere from 1-3 rows depending on the type of change being documented. The only constants are the contents of the cells in column A.

Thanks.

Hi mkraffert

Welcome to the Forum!

I'd have to say, if

My macro works fine

then it's not

"stupid"

It may need to be cleaned up a bit and we can help you with that. Won't be me tonight...perhaps another...if not, I'll look at it tomorrow.

Hi mkraffert

Here's new Code for Sub Dev()

Option Explicit

Sub Dev()
' Keyboard Shortcut: Ctrl+d
    Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
    Dim LR As Long, LC As Long
    Dim myBorders() As Variant, item As Variant
    
    Set ws = Sheets("FL")
    Set ws1 = Sheets("Dev")
    Application.ScreenUpdating = False
    ws1.Cells.Clear
    ws.Cells.Copy Destination:=ws1.Range("A1")
    Application.CutCopyMode = False

    ' Delete Unneeded Columns
    ' (Always the same columns)

    With ws1
        .Activate
        .Columns("A:A").Delete Shift:=xlToLeft
        .Columns("F:K").Delete Shift:=xlToLeft
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        .Range("A1:A" & LR).AutoFilter Field:=1, Criteria1:="=Number", _
                Operator:=xlOr, Criteria2:="="
        .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

        .Range("A1:A" & LR).AutoFilter Field:=1, Criteria1:="=*Existing*"
        .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilterMode = False
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column

        myBorders = Array(xlInsideVertical, xlInsideHorizontal)
        .Range(Cells(1, 1), .Cells(LR, LC)).Select
        For Each item In myBorders
            With Selection.Borders(item)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        Next item

        myBorders = Array(xlEdgeTop, xlEdgeBottom, xlEdgeRight)
        .Range(Cells(1, 1), .Cells(LR, LC)).Select
        For Each item In myBorders
            With Selection.Borders(item)
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = xlAutomatic
            End With
        Next item
    End With
    Application.ScreenUpdating = True
End Sub

Why don't you play with Sub Threshold()...run into troubles let me know.

You're welcome...glad I could help. Thanks for the Rep.