Using VBA to remove a row which contains a keyword

[dleach19]

All,

I have a workbook which I am using to track a large number of deals. Column G in the Tracking Report provides a "Deal Status". I was hoping someone could help me with the VBA code to do the following:

1) go to the last active row in Column G on the Tracking Report worksheet

2) Begin Looping through the rows and identifying if Column G has the Deal Status as "Dead"

3) If the Deal Status is "Dead" Cut the entire row and move it to the "Dead Deals" sheet

4) If the status is anything but "Dead" leave it alone and move on to the next one

Any help would be greatly appreciated!

 

[dleach19]

Ok I think I spoke to soon. This code referred to the below. When I put together a test sheet it worked great but when I tried to drop it into my working tracking report the macro would run, but it would not grab the "Dead" deals. Let me try to explain the sheet a little further and maybe that will help:

1) The Column Titles are listed across Row 4 and begin in Cell B4. So there is no data entered in Column A or in rows 1:3.
2) The first row of Data in the tracking report starts in Cell B6 and extends over to cell AK6, the report is dynamic so the last row of data is constantly changing depending on how many deals have been added that day. There is no Data included in Row 5.
3) All the Data in Column B is stagnant with the name of the deal
4) Columns C:AK have a variation of the following formula in them which pulls the data from each individual deal's worksheet:
=IF(IFERROR(INDIRECT(ADDRESS(INDEX(CellIdentity!$C$6:$C$26,MATCH(X$4,CellIdentity!$B$6:$B$26,0)),INDEX(CellIdentity!$D$6:$D$26,MATCH(X$4,CellIdentity!$B$6:$B$26,0)),1,1,$B8)),"CHECK") = 0, "",IFERROR(INDIRECT(ADDRESS(INDEX(CellIdentity!$C$6:$C$26,MATCH(X$4,CellIdentity!$B$6:$B$26,0)),INDEX(CellIdentity!$D$6:$D$26,MATCH(X$4,CellIdentity!$B$6:$B$26,0)),1,1,$B8)),"CHECK"))
5) Please let me know if you need clarification on the above formula, in short it allows us to dynamically add deals to the workbook and have them populate on the Tracking Report using a different macro.

I modified the code below to the following to try and have it match up with my existing report:

Sub CutDeadDeals()


    'Assumes headers in row 1
    Dim lR As Long, R As Range, n As Long


    lR = Range("G" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False


    Set R = Range("G6:G" & lR).CurrentRegion
    R.AutoFilter field:=7, Criteria1:="Dead"
    
    Set R = R.Rows("6:" & lR)
    R.Copy


    With Sheets("Dead Deals")
        lR = .Range("B" & Rows.Count).End(xlUp).Row + 1
        .Range("B" & lR).PasteSpecial Paste:=xlPasteValues
    End With


    On Error Resume Next
    
    R.Delete shift:=xlUp
    Range("G6").AutoFilter
    Application.ScreenUpdating = True


End Sub

Please let me know if you have any thoughts.


Sub CutDeadDeals()'Assumes headers in row 1Dim lR As Long, R As Range, n As LonglR = Range("G" & Rows.Count).End(xlUp).RowApplication.ScreenUpdating = FalseSet R = Range("G1:G" & lR).CurrentRegionR.AutoFilter field:=7, Criteria1:="Dead"Set R = R.Rows("2:" & lR)R.CopyWith Sheets("Dead Deals") lR = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & lR).PasteSpecial Paste:=xlPasteValuesEnd WithOn Error Resume NextR.Delete shift:=xlUpRange("G1").AutoFilterApplication.ScreenUpdating = TrueEnd Sub
</pre>

 

[dleach19]

Any thoughts on the above conditions?