Adding to existing macro - moving rows to new sheet if yes

downpastthesign

New Member
Joined
Jul 12, 2018
Messages
3
Hi everyone,

Months ago, with the help of this forum, I created the below macro to copy all the documents flagged "Yes" in my Cases worksheet over to my High Priority sheet. It's been working great.

Sub Test()
Dim m As Variant
Dim MatchRow As Long
Dim Cell As Range

With Sheets("Cases")
For Each Cell In .Range("L:L")
m = Application.Match(Cell.Text, Array("Yes"), False)
If Not IsError(m) Then
Cell.EntireRow.Copy Destination:=Worksheets("High Priority").Range("A" & lastrow2 + 1)
lastrow2 = lastrow2 + 1
Else:
End If
Next
End With
End Sub

Now I need to be able to have the macro undertake the following, which is outside my abilities:
- input the rows flagged "Yes" starting at cell A3 to allow for headings to be added in
- only copy over columns A to K
- do all the above for a new sheet called Cases2

Any assistance is greatly appreciated.
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
I thought I would give this a Bump as I had the chance to play around in my sheet today, but accomplished nothing. Thanks in advance!
 
Upvote 0
Hello DPTS,

If I've understood your opening post correctly, you have two source sheets (Cases and Cases2) and a destination sheet (High Priority).
In Column L of the two source sheets, you type in "Yes" in the relevant cell of the relevant row when a "case" is ready to be prioritised. Based on the "Yes" criteria being placed in the relevant cell, the data from Columns A:K of the relevant rows then needs to be transferred to the destination sheet (High Priority).

If this is correct, then I believe that the following code should work for you:-


Code:
Sub Test()

Dim ws As Worksheet, sh As Worksheet

Set sh = Sheets("High Priority")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In Worksheets
If ws.Name <> "High Priority" Then

With ws.[A3].CurrentRegion
            .AutoFilter 12, "Yes"
            .Columns("A:K").Offset(1).Copy
            sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
            '.Columns("A:K").Offset(1).Delete
            .AutoFilter
             End With
       End If
Next ws
     
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

The code replaces your existing code as using autofilter should speed the whole process up considerably.
The code will filter Column L of both the source sheets for the criteria "Yes" and then transfer the relevant rows of data to the High Priority sheet. This code will work for any number of source sheets that you may need to create in the future.

I've assumed that headings in all source sheets are in row3 with data starting in row4.
I'm not sure if you wanted the "used" data from the source sheets deleted after each transfer of data so I have added a line of code which will do this. It is currently commented out but if you wish to activate it then just remove the apostrophe from in front of the line of code.

Please test the code in a copy of your workbook first.

I hope that this helps.

Cheerio,
vcoolio.
 
Upvote 0
Thanks you so much. What you provided did work until I reopened the document aand few hours later and was met with an error message. When i looked into the issue the debug was highlighting .AutoFilter 12, "Yes" as the issue but I am not sure why it was wrong when it had been previously working. Would you have any thoughts on why that is occurring?
 
Upvote 0
Greetings DPTS,

Odd behaviour to say the least!

What does the error message say?

Cheerio,
vcoolio.

P.S. Did you insert an extra column per chance?
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,651
Messages
6,120,739
Members
448,989
Latest member
mariah3

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