VBA: Copy & Delete row based on cell value

iDeals

Board Regular
Joined
Oct 22, 2008
Messages
236
Okay, so I'm trying to build a code that will copy specific rows based on a cell value in that row, and after pasting to a separate spreadsheet, delete those rows. I was looking at this code for inspiration, but admittedly I am not very good in VBA and am having no luck

Code:
Option Explicit

[B]Sub FastestAndMostFlexible()[/B]
[COLOR=#008000]''''''''''''''''''''''''''
'Written by www.ozgrid.com
''''''''''''''''''''''''''[/COLOR]

Dim rRange As Range
Dim strCriteria As String
Dim lCol As Long
Dim rHeaderCol As Range
Dim xlCalc As XlCalculation
Const strTitle As String = "OZGRID CONDITIONAL ROW DELETE"

    On Error Resume Next
Step1:
    [COLOR=#008000]'We use Application.InputBox type 8 so user can select range[/COLOR]
    Set rRange = Application.InputBox(Prompt:="Select range including header range" _
        , Title:=strTitle & " STEP 1 of 3", Default:=ActiveCell.CurrentRegion.Address, Type:=8)
        
    [COLOR=#008000]'Cancelled or non valid rage[/COLOR]
    If rRange Is Nothing Then Exit Sub
     [COLOR=#008000]'Awlays use GoTo when selecting range so doesn't matter which Worksheet[/COLOR]
     Application.Goto rRange.Rows(1), True
    
Step2
    [COLOR=#008000]'We use Application.InputBox type 1 so return a number[/COLOR]
    lCol = Application.InputBox(Prompt:="Please enter relative column number of evaluation column" _
        , Title:=strTitle & " STEP 2 of 3", Default:=1, Type:=1)
        
    [COLOR=#008000]'Cancelled[/COLOR]
    If lCol = 0 Then Exit Sub

Step3:
    [COLOR=#008000]'We use default InputBox type as we want Text[/COLOR]
    strCriteria = InputBox(Prompt:="Please enter a single criteria." & _
        vbNewLine & "Eg >5 OR <10 OR Cat* OR *Cat OR *Cat*" _
        , Title:=strTitle & " STEP 3 of 3")
        
    If strCriteria = vbNullString Then Exit Sub
    
 [COLOR=#008000]   'Store current Calculation then switch to manual.
    'Turn off events and screen updating[/COLOR]
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
        
    
    [COLOR=#008000]'Remove any filters[/COLOR]
    ActiveSheet.AutoFilterMode = False
    
    With rRange [COLOR=#008000]'Filter, offset(to exclude headers) and delete visible rows[/COLOR]
      .AutoFilter Field:=lCol, Criteria1:=strCriteria
      .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    [COLOR=#008000]'Remove any filters[/COLOR]
    ActiveSheet.AutoFilterMode = False
    
      'Revert back
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
   On Error GoTo 0
[B]End Sub[/B]
</pre>

any suggestions?

Thanks!
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
The column is "P" the value it will be looking for is "Closed" - the data ideally would be copied and then pasted into a tab labeled "Closed" after which the row it was copied from in the original tab "Pipeline" would be deleted. Thanks for taking a look at this!
 
Upvote 0
The column is "P" the value it will be looking for is "Closed" - the data ideally would be copied and then pasted into a tab labeled "Closed" after which the row it was copied from in the original tab "Pipeline" would be deleted. Thanks for taking a look at this!


Maybe:

Code:
Sub iDeals()
Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

With Range("P2:P" & lr)

    .AutoFilter Field:=1, Criteria1:="Closed"
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Closed").Range("A" & Rows.Count).End(3)(2)
    .SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
    .AutoFilter
    .AutoFilter
    
End With
        
End Sub
 
Upvote 0
That cut row 1 from Sheets("Pipeline"), pasted it into Sheets("Closed") in row 2, and then deleted row 1 from Sheets("Pipeline"). Looks like it's almost there, just not selected the right rows.

Thanks again for helping!
 
Upvote 0
*as a side note Row 1 in Sheet "Pipeline" is a column label row.

Does this get it?

Code:
Sub iDeals()
Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

With Range("P3:P" & lr)

    .AutoFilter Field:=1, Criteria1:="Closed"
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Closed").Range("A" & Rows.Count).End(3)(2)
    .SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
    .AutoFilter
    .AutoFilter
    
End With
        
End Sub
 
Upvote 0
*as a side note Row 1 in Sheet "Pipeline" is a column label row.

Does this get it?

Code:
Sub iDeals()
Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

With Range("P3:P" & lr)

    .AutoFilter Field:=1, Criteria1:="Closed"
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Closed").Range("A" & Rows.Count).End(3)(2)
    .SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
    .AutoFilter
    .AutoFilter
    
End With
        
End Sub
 
Upvote 0
Does this get it?

Code:
Sub iDeals()
Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

With Range("P3:P" & lr)

    .AutoFilter Field:=1, Criteria1:="Closed"
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Closed").Range("A" & Rows.Count).End(3)(2)
    .SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
    .AutoFilter
    .AutoFilter
    
End With
        
End Sub


Not quite there, it is now coping and pasting correctly (not doing the column labels), unfortunately it seems to be grabbing one row at random and moving it even when there are no items in Column P that equal "Closed"
 
Upvote 0

Forum statistics

Threads
1,226,719
Messages
6,192,660
Members
453,743
Latest member
ntguy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top