Link to home
Start Free TrialLog in
Avatar of shamilaz
shamilaz

asked on

Filter, cut and paste data in new worksheet

Hi,

I have a filter on row8 across all fields in sheet "Pending Ports".  cell T20 is filtered on values"Rejected"and "Cancelled"

these values should be cut ans pasted in sheet 'RejectedCancelled" starting from row A10 and thereafter all cut and paste values / data will be pasted on the first availble blank cell.

any help is urgently appreciated

thanks
Avatar of terencino
terencino
Flag of Australia image

Hi shamilaz, give this macro a try. It uses a search>cut>paste> delete approach, doesn't use AutoFilter functionality at all. The Advanced Filter is only suitable for the same sheet, so I thought this would be easier and quicker to get a result for you.
Let me know how it goes
...Terry
Sub MoveRejects()
Dim c As Range, port_sheet As Worksheet, reject_sheet As Worksheet
Set port_sheet = Worksheets("Pending Ports")
Set reject_sheet = Worksheets("RejectedCancelled")
reject_column = 20
Application.ScreenUpdating = False
Do Until finished = "Yes"
For Each c In port_sheet.Columns(reject_column).Cells
If c.Row > port_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row Then
    finished = "Yes"
    Exit For
End If
    If c.Value = "Rejected" Or c.Value = "Cancelled" Then
        port_sheet.Rows(c.Row).Copy reject_sheet.Rows(reject_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
        port_sheet.Rows(c.Row).Delete
    End If
Next c
Loop
Application.ScreenUpdating = True
End Sub

Open in new window

Oh, here's the spreadsheet I used for the trial...
MoveRejected.xlsm
Avatar of shamilaz
shamilaz

ASKER

Clarification:-)

I tested it on my WS.  It removes cancelled and rejected in stages.  example I have to run the code a few times for it to take out record by record ...Is that how its supposed to be and not take all rejected and cancelled in one click or run of the macro?

also would I forgot to mention...would it be possible to do a macro to undo what has been moved if thats ok with you...my apologies...I can ask as another question if need be.

thanks
No it was supposed to remove them in one go. Hard to tell why without your spreadsheet. I'll try a different approach and get back to you soon
Avatar of Rob Brockett
hi everyone,

Terry, when deleting rows the code needs to work from the bottom up, otherwise each row deletion causes  the "next" row becomes the "current" row before the row is incremented at the end of the loop. In a loop this can be done using a syntax along the lines of "for i = LastRow to HdrRow Step -1...".

Shamilaz,
Here's a version that uses autofilter. It may need some adjustments...

Option Explicit

Sub Macro5()
Const FirstPasteRow As Long = 10
Dim PasteWs As Worksheet
Dim AfRng As Range
Dim AfDataOnlyRng As Range
Dim PasteCll As Range
Dim VisClls As Range

    With ThisWorkbook
        Set AfRng = .Worksheets("Pending Ports").AutoFilter.Range
        Set PasteWs = .Worksheets("RejectedCancelled")
    End With

    With PasteWs
        Set PasteCll = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        If PasteCll.Row < FirstPasteRow Then
            Set PasteCll = .Range("A" & FirstPasteRow)
        End If
    End With

    With AfRng
        Set AfDataOnlyRng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
        '###note this doesn't check for any other filters (before applying the below filtering criteria), do you need it to?
        .AutoFilter Field:=20, Criteria1:= _
                    "=Cancelled", Operator:=xlOr, Criteria2:="=Rejected"
        Set VisClls = AfDataOnlyRng.SpecialCells(xlCellTypeVisible)
        If Not VisClls Is Nothing Then
            VisClls.Copy PasteCll
        End If
        .AutoFilter Field:=20
    End With

    Set VisClls = Nothing
    Set PasteCll = Nothing
    Set PasteWs = Nothing
    Set AfRng = Nothing
    Set AfDataOnlyRng = Nothing
End Sub

Open in new window


hth
Rob
Hi  terry,

the other issue that I am facing with the code that you sent me is ...the values that are copied(that are in "Pending Ports") are getting some rows from a vlookup.  so when the records are copied and moved to "RejectedCancelled"  the vlookup values just show"VAlue" and nothing else or the wrong street address.  any ideas where when pasting it can be done as "values" so that it does not look for a lookup value?

ss attached,

thanks

Rob,  thanks for yr submission as well......ran into an error 400
OK Shamilaz, here is an updated version using the AutoFilter as recommended by Rob. It is  a bit clumsy using copy & paste special values but it does work. Can you try this and let me know. It should be relatively easy to reverse the process to "undo" the change, but likely all the rows that were moved would be added back at the end of the first list

Sub MoveRejects()
Dim c As Range, port_sheet As Worksheet, reject_sheet As Worksheet, r As Range
Set port_sheet = Worksheets("Pending Ports")
Set reject_sheet = Worksheets("RejectedCancelled")
reject_column = 19
Application.ScreenUpdating = False
port_last_row = port_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
port_sheet.ListObjects("Table2").Range.AutoFilter Field:=reject_column, Criteria1:= _
    "=Cancelled", Operator:=xlOr, Criteria2:="=Rejected"
For Each r In port_sheet.ListObjects("Table2").Range.Rows
i = i + 1
    If i = 1 Then
        GoTo skip
        End If
    If r.Hidden = True Then GoTo skip
    reject_last_row = reject_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
    r.Copy
    reject_sheet.Range("A" & reject_last_row).PasteSpecial xlPasteValues
    reject_sheet.Range("A" & reject_last_row).PasteSpecial xlPasteFormats
skip:
Next r
Application.CutCopyMode = False
port_sheet.Rows("9:" & port_last_row).delete Shift:=xlUp
port_sheet.ShowAllData
Application.ScreenUpdating = True
End Sub

Open in new window

Thanks Terry, works great just as you stated.....in case I want to reverse the cut and paste how would I undo the change?...is there a simple change

thanks
I think we could store the rows they were moved from and to, either in a global variable or even on a hidden sheet. So that way we would be able to move thing back to where they cam from. The formulas would need to be reinstated, and there might be some issue with the defined tables (they are ListObjects not just plain ranges) but it could be done without too much difficulty I think. I'll have a look at it tomorrow!
...Terry
thanks Terry...much appreciated
Also Terry, the same file but fewer columns, I tried amending and applying the same formula/macro that worked earlier and it failed.  Appreciate if you could have a look and amend as a whole for the attached doc please...and then we are good to go.  When the Status (Column 9 changes from OPEN to CLOSED, these records should move to the incidents closed tab
TEMP.xlsx
This works for the new workbook, mostly the same structure as the original, different in a many other respects as it is very specific to the structure of the tables and names. You could look at the code side by side to see the differences, let me know if you need any further explanation. Note that now it stores the rows moved from and to, and also included is another macro as discussed to "undo" the previously moved rows MoveClosedUndo.
...Terry


Public MovedFromRows, MovedToRows

Sub MoveClosed()
Dim c As Range, open_sheet As Worksheet, closed_sheet As Worksheet, r As Range
Set open_sheet = Worksheets("Incidents OPEN")
Set closed_sheet = Worksheets("Incidents CLOSED")
closed_column = 9
Application.ScreenUpdating = False
open_last_row = open_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
open_sheet.ListObjects("Table6").Range.AutoFilter Field:=closed_column, Criteria1:="=Closed"
For Each r In open_sheet.ListObjects("Table6").Range.Rows
    i = i + 1
    If i = 1 Then
        GoTo skip
        End If
    If r.Hidden = True Then GoTo skip
    closed_last_row = closed_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
    r.Copy
    closed_sheet.Range("A" & closed_last_row).PasteSpecial xlPasteValues
    closed_sheet.Range("A" & closed_last_row).PasteSpecial xlPasteFormats
    j = j + 1
    If j = 1 Then
        MovedFromRows = r.Row
        MovedToRows = closed_last_row
    Else
        MovedFromRows = MovedFromRows & "|" & r.Row
        MovedToRows = MovedToRows & "|" & closed_last_row
    End If
skip:
Next r
Application.CutCopyMode = False
open_sheet.Rows("9:" & open_last_row).Delete Shift:=xlUp
Range("Table6[[#Headers],[Status]]").Select
open_sheet.ShowAllData
Application.ScreenUpdating = True
End Sub

Sub MoveClosedUndo()
Dim c As Range, open_sheet As Worksheet, closed_sheet As Worksheet, r As Range, a As Variant, newRow As ListRow
Set open_sheet = Worksheets("Incidents OPEN")
Set closed_sheet = Worksheets("Incidents CLOSED")
Application.ScreenUpdating = False
a = Split(MovedToRows, "|")
For k = LBound(a) To UBound(a)
    Set newRow = open_sheet.ListObjects("Table6").ListRows.Add
    closed_sheet.Rows(CLng(a(k))).Copy
    newRow.Range.Cells(1, 1).PasteSpecial xlPasteValues
    newRow.Range.Cells(1, 1).PasteSpecial xlPasteFormats
Next k
Application.CutCopyMode = False
closed_sheet.Rows(a(LBound(a)) & ":" & a(UBound(a))).Delete Shift:=xlUp
Application.ScreenUpdating = True

End Sub

Open in new window

TEMP.xlsm
Hi Terry,

Tried using it on this version.  Should have worked but does not for the "Incidents OPEN " and "Incidents CLOSED " tabs....kindly appreciate if you could please have a look and get back.

and if required amend the code to this sample...I think the different versions may be the issue

thanks very much
original-sample.xlsm
Hi Terry,

Instead of the last macro you sent me I used the following and it cuts / deletes the "closed" record nicely, but does not put it in the next blank row in the Incidents CLOSED sheet.  It instead does it over and over again in the same row.  Appreciate greatly if you can amend this macro at least Terry, Thanks very much

Sub MoveEm()
    Dim rng1 As Range, rng2 As Range, cel As Range
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim SearchStr As String
    Dim i As Long
 
    Set ws1 = Sheets("Incidents OPEN")
    Set ws2 = Sheets("Incidents CLOSED")
    SearchStr = "Closed"
 
    Set rng1 = Intersect(ws1.UsedRange, ws1.Columns("G"))
    If rng1 Is Nothing Then Exit Sub
 
    Application.ScreenUpdating = False
 
    Do
        Set cel = rng1.Find(SearchStr, , xlValues, xlWhole, xlByRows)
        If cel Is Nothing Then Exit Do
        i = i + 1
        ws2.Rows(i).Value = ws1.Rows(cel.Row).Value
        ws1.Rows(cel.Row).copy
        ws2.Rows(i).PasteSpecial Paste:=xlPasteFormats
        ws1.Rows(cel.Row).EntireRow.delete
        Set cel = Nothing
    Loop
   
    Application.ScreenUpdating = True
 
End Sub
ASKER CERTIFIED SOLUTION
Avatar of terencino
terencino
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Ooopps, I was too slow again!

At least my thoughts are along the same lines as Terry's ie he uses "closed_last_row + i".

Rob
Hi Terry and Rob,

You guys were both great:-).  However Rob I hope you understand that I had to allocate more points for Terry due to his time on these requests and Terry I do hope you understand that Rob contributed as well.

Both you gentlemen have been extremely helpful and I will surely be reaching out to you both again:-)

Thanks very much

Shamil
hi Shamil,

Thank you for the points, I definitely understand, in fact I'm surprised to get any points. Please do feel free to give them all to Terry.

Would you mind posting your final solution?
This may be helpful for other users who search the EE site.

Rob