VBA - search data, delete it from current worksheet and paste to a new worksheet

iris1007

New Member
Joined
Jun 28, 2017
Messages
31
Hi,
I have a huge data which I need to search for Vendor with "delete" note, delete the whole row from the current worksheet and paste the whole row data into a new worksheet.
Below is the sample data:
Original - before the deletion - Sheet1

VendorsPart #Ref #
123FDG071-50001-8102F149120021
123FDG071-50001-8102F149120021
123FDG071-50001-8102F149120021
123FDG to delete071-50001-8102F149120021
ABC0145-5521-114537Z-15142396
ABC0145-5521-114537Z-16548768
ABC - to delete0145-5521-114537Z-138804512
ASDFR12307F10-15032601881A-CBB26680
ASDFR12307F10-15032601881A-CDD27477
IBM07F10-1503260181145214
IBM07F10-1503260182255551420
IBM07F10-15032601822523413G67
IBM07F10-15032601822523413G67
IBM07F10-15032601822523413G67
IBM - to delete07F10-15032601822502171
IBM07F10-150326018225762201D
IBM07F10-150326018225F0991
IBM07F10-15032601822611AD123
IBM07F10-15032601822611AD123
IBM07F10-150326018ABC22622
IBM07F10-150326018F23201884
IBM - to delete07F10-1503260182255551420
IBM - to delete07F10-150326018225F0991
OCBBC07F10-1503260182-A4276-00
OCBBC07F10-1503260182-A4276-00
OCBBC07F10-15032601881A-CAA26474
OCBBC - to delete07F10-15032601881A-CBB26680
XYZ1207F10-150326018F23201884
XYZ1207F10-150326018F23201884
XYZ1207F10-150326018A23267
XYZ1207F10-150326018ZX-10-23809
XYZ1207F10-150326018ZX-10-23809
XYZ12 - to delete07F10-150326018A23267
<colgroup><col width="129" style="width: 97pt; mso-width-source: userset; mso-width-alt: 4579;"> <col width="181" style="width: 136pt; mso-width-source: userset; mso-width-alt: 6428;"> <col width="122" style="width: 92pt; mso-width-source: userset; mso-width-alt: 4352;"> <tbody> </tbody>

Sheet1 - after deletion
VendorsPart #Ref #
123FDG071-50001-8102F149120021
123FDG071-50001-8102F149120021
123FDG071-50001-8102F149120021
ABC0145-5521-114537Z-15142396
ABC0145-5521-114537Z-16548768
ASDFR12307F10-15032601881A-CBB26680
ASDFR12307F10-15032601881A-CDD27477
IBM07F10-1503260181145214
IBM07F10-1503260182255551420
IBM07F10-15032601822523413G67
IBM07F10-15032601822523413G67
IBM07F10-15032601822523413G67
IBM07F10-150326018225762201D
IBM07F10-150326018225F0991
IBM07F10-15032601822611AD123
IBM07F10-15032601822611AD123
IBM07F10-150326018ABC22622
IBM07F10-150326018F23201884
OCBBC07F10-1503260182-A4276-00
OCBBC07F10-1503260182-A4276-00
OCBBC07F10-15032601881A-CAA26474
XYZ1207F10-150326018F23201884
XYZ1207F10-150326018F23201884
XYZ1207F10-150326018A23267
XYZ1207F10-150326018ZX-10-23809
XYZ1207F10-150326018ZX-10-23809
<colgroup><col width="129" style="width: 97pt; mso-width-source: userset; mso-width-alt: 4579;"> <col width="181" style="width: 136pt; mso-width-source: userset; mso-width-alt: 6428;"> <col width="122" style="width: 92pt; mso-width-source: userset; mso-width-alt: 4352;"> <tbody> </tbody>

Sheet2 (NEW)

VendorsPart #Ref #
123FDG to delete071-50001-8102F149120021
ABC - to delete0145-5521-114537Z-138804512
IBM - to delete07F10-15032601822502171
IBM - to delete07F10-1503260182255551420
IBM - to delete07F10-150326018225F0991
OCBBC - to delete07F10-15032601881A-CBB26680
XYZ12 - to delete07F10-150326018A23267
<colgroup><col width="146" style="width: 110pt; mso-width-source: userset; mso-width-alt: 5205;"> <col width="203" style="width: 152pt; mso-width-source: userset; mso-width-alt: 7224;"> <col width="102" style="width: 77pt; mso-width-source: userset; mso-width-alt: 3640;"> <tbody> </tbody>

Hope anyone there can help. Thanks!
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Hi
try following code & see if does what you want


Place in STANDARD module

Code:
Sub CopyDeleteRows()
    Dim c As Range, CopyRange As Range, DataRange As Range
    Dim DestRange As Range


    With ThisWorkbook
'source sheet
        With .Sheets("Sheet1")
            Set DataRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
        End With
'destination Sheet
        With .Sheets("Sheet2") '
            Set DestRange = .Range("A2")
        End With
    End With
    
    DataRange.EntireRow.Hidden = False
    
    For Each c In DataRange.Cells
        If UCase(Right(c.Value, 6)) = "DELETE" 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


Dave
 
Upvote 0
Hi Dave. This was just what I was looking for so thank you.

However, when I copy to another sheet I would like to use copy values only rather than taking the functions - I'm copying from a table and don't want the references to be copied.

Kent
 
Upvote 0
@Kentman
Please do not "hijack" other peoples threads. If you need help please start a thread of your own. You can always add a link back to this post if you feel it's relevant.
 
Upvote 0
Sorry Fuff. Didn't think I was hijacking just thought it was expanding on the question as it would extend the answer for others and it was to the person who added the solution. Will post new thread.
 
Upvote 0
Hi Dave,
Thank you so much for the helps.  
If the "DELETE" column is not in "A" but in "C", can I still search and delete the whole row and copy it to Sheet2? 

Also, as I will be running this report every two weeks, the new "DELETE" row will be paste to Sheets2 the next empty row?
Thanks!

 
Upvote 0
Hi Dave,
Thank you so much for the helps.  
If the "DELETE" column is not in "A" but in "C", can I still search and delete the whole row and copy it to Sheet2? 

Also, as I will be running this report every two weeks, the new "DELETE" row will be paste to Sheets2 the next empty row?
Thanks!


Hi,
Try this update

Rich (BB code):
Sub CopyDeleteRows()
    Dim c As Range, CopyRange As Range, DataRange As Range
    Dim DestRange As Range
    Dim SearchColumn As String


    SearchColumn = "A"


    With ThisWorkbook
'source sheet
        With .Sheets("Sheet1")
            Set DataRange = .Range(.Range(SearchColumn & "2"), .Range(SearchColumn & .Rows.Count).End(xlUp))
        End With
'destination Sheet
        With .Sheets("Sheet2") '
            Set DestRange = .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, 1)
        End With
    End With
    
    DataRange.EntireRow.Hidden = False
    
    For Each c In DataRange.Cells
        If UCase(Right(c.Value, 6)) = "DELETE" 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

I have added variable to allow you to set which column you want to search. Just change value shown in RED as required.
Updated code should append copied data to next row in sheet 2.

Dave
 
Upvote 0
Hi,
I have a huge data which I need to search for Vendor with "delete" note, delete the whole row from the current worksheet and paste the whole row data into a new worksheet.

So you have a huge data .
How many data rows is it? more than 100k?
Another option is to use filter:
1. Filter the data using criteria contain "delete"
2. then copy the filtered data to the second sheet.
3. back to the first sheet, to delete the filtered data you can use this code:

Code:
Sub a1079048a()

Dim rng As Range
Set rng = Range("A2", Cells(Rows.count, "A").End(xlUp))
rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete

End Sub
 
Upvote 0
Hi Dave,
Awesome. Thank you so much for all the helps. This will really improve my productivity at work.

 
Upvote 0
Hi Dave,
Awesome. Thank you so much for all the helps. This will really improve my productivity at work.


Hi,
you are welcome - glad solution does what you want.

Many thanks for feedback

Dave
 
Upvote 0

Forum statistics

Threads
1,216,059
Messages
6,128,542
Members
449,457
Latest member
ncguzzo

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