Make Certain Rows Automatically Appear in Other Tabs?!

thisisbaris

New Member
Joined
Sep 15, 2017
Messages
6
My spreadsheet has five key columns (B, D, G, H, AA) among a bunch of other hidden columns.

"Unique ID", "Location", "Value", "Date", and "Priority".

rkorqw.jpg


When I copy and paste raw data into the first four columns, the hidden spreadsheet formulae do their thing and for each item on each row, the "Priority" will be determined (Priority 1, 2, or 3) based on a bunch of criteria etc.

Now I want these to appear in a new spreadsheet's separate tabs for "Priority 1", "Priority 2", "Priority 3". For however many rows there are (could be 50, or as many as 15,000 rows of data) I want all "Priority 1" rows in the "Priority 1" tab along with their relevant "Unique ID", "Location", "Value", and "Date" information. And of course, the same for "Priority 2" and "Priority 3".

Is there a simple formula that can be written in each of the "Priority" tabs and just dragged down?
Or do I need a more complex macro? THANKS!

1zvg845.jpg


PS: The above is what I'm looking for the final result to be!
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
The macro assumes you have headers in row 1, the data starts in row 2 and the "Priority" sheets need to be created. Change the sheet name (in red) to suit your needs.
Code:
Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object, lastRow As Long, ws As Worksheet, item As Variant
    Set RngList = CreateObject("Scripting.Dictionary")
    lastRow = Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]").Cells(Rows.Count, "AA").End(xlUp).Row
    For Each Rng In Sheets("Sheet1").Range("AA2:AA" & lastRow)
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next Rng
    For Each item In RngList
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(item)
        On Error GoTo 0
        If ws Is Nothing Then
            Worksheets.Add(After:=Sheets(Sheets.Count)).Name = item
            With Sheets("Sheet1")
                .Range("AA1:AA" & lastRow).AutoFilter Field:=1, Criteria1:=item
                Intersect(.Rows("2:" & lastRow), .Range("B:B,D:D,G:G,H:H")).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Range("A1").AutoFilter
            End With
        End If
    Next item
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,977
Messages
6,175,753
Members
452,667
Latest member
vanessavalentino83

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