Cut, Paste, Delete based on values from a list

Lovelylou79

New Member
Joined
Sep 4, 2017
Messages
37
Hi Excel Community,

Long time code thief, first time poster....

I'm looking for assistance with Cutting, Pasting and Deleting rows from Sheet 1 to Sheet 3 ("#PRU"), based on a list of values from Sheet 2 ("Codes").

I have investigated several codes from this and other forums, however I can not seem to make them fit my exact purposes.

The closest I have come is the following, which bugs out at the "Insert" line;

Sub cutrows()
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "#PRU"
Dim d As Object, e, rws&, cls&, i&, j&
Set d = CreateObject("scripting.dictionary")
For Each e In Sheets("Codes").Range("A1").CurrentRegion
d(e.Value) = 1
Next e
Sheets("Phish").Activate
rws = Cells.Find("*", After:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
cls = Cells.Find("*", After:=[a1], searchorder:=xlByColumns, _
searchdirection:=xlPrevious).Column
For i = rws To 1 Step -1
For j = 1 To cls
If d(Range("A1").Resize(rws, cls)(i, j).Value) = 1 Then _
Cells.Rows(i).Cut Sheets("#PRU").Range("1:1").EntireRow.Insert: Exit For
Next j, i
End Sub

This code was originally intended for deleting the rows, I have tried to manipulate it to cut and paste. Ideally the row would be deleted once the cut/paste function is completed.

Any assistance would be greatly appreciated.
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Hi,
welcome to forum.

Not fully tested but give following a try & see if it goes in right direction for you

Code:
Sub CopyDeleteRows()
    Dim c As Range, CopyRange As Range, DataRange As Range
    Dim DestRange As Range
    Dim arr As Variant
    Dim wsPRU As Worksheet


    With ThisWorkbook
        With .Sheets("Codes")
'values to copy - change range as required
            arr = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)).Value
        End With
        With .Sheets("Phish")
'copy sheet 1
            Set DataRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
        End With


    On Error Resume Next
    Set wsPRU = .Worksheets("#PRU")
    If Err.Number = 9 Then
'if sheet does not exist create it
        Set wsPRU = .Worksheets.Add(after:=.Worksheets(.Sheets.Count))
        wsPRU.Name = "#PRU"
    Else
'optional
         wsPRU.Cells.Clear
    End If
    End With
    
    On Error GoTo 0
    
'copy destination
    Set DestRange = wsPRU.Range("A1")
    
    For Each c In DataRange.Cells
        m = Application.Match(c.Value, arr, False)
        If Not IsError(m) Then
            If CopyRange Is Nothing Then
                Set CopyRange = c
            Else
                Set CopyRange = Union(CopyRange, c)
            End If
        End If
    Next c
    
    If Not CopyRange Is Nothing Then
        With CopyRange.EntireRow
            .Copy DestRange
            .Delete shift:=xlShiftUp
        End With
    End If


End Sub

Note: I have assumed that list values are in column 1 (A) of your codes sheet & the same for the search range in sheet 1 ("Phish") you will need to adjust as required.

Always make a back-up of your workbook before testing new code.

Hope Helpful

Dave
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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