List all instances of a value from a list of mixed values to separate tab

[clamont7]

I have a column of data on a tab called "Data Dump" in column A. The column contains 5 different product codes. I'm trying to do something along the lines of:

If A2 on the "Data Dump" tab equals "S-7", copy and paste A2, B2, C2, and D2 to a new tab called "S-7" starting with cell A9.
Do this the whole way down the column on the "Data Dump" tab for "S-7"

Ex.
Data Dump New Tab
S-7 S-7
S-7 S-7
S-7 S-7
T-C S-7
T-C S-7
W-1
S-7
S-7

I can't seem to get them listed like above (without empty spaces between matches). Any help would be greatly appreciated!

 

[JoeMo]

This will create the new sheet called "S-7".

Sub clamont7()
Dim Rsource As Range, Rdest As Range, V, i As Long
Set Rsource = Sheets("Data Dump").Range("A2:D" & Sheets("Data Dump").Cells(Rows.Count, "A").End(xlUp).Row)
Application.DisplayAlerts = False
On Error Resume Next
Sheets("S-7").Delete
On Error GoTo 0
Sheets.Add after:=Sheets("Data Dump")
ActiveSheet.Name = "S-7"
Application.ScreenUpdating = False
With Sheets("S-7")
    Set Rdest = .Range("A9").Resize(Rsource.Rows.Count, Rsource.Columns.Count)
    Rdest.Value = Rsource.Value
    V = Rdest.Value
    For i = 1 To UBound(V, 1)
        If V(i, 1) <> "S-7" Then V(i, 1) = ""
    Next i
    Rdest.Value = V
    On Error Resume Next
    Rdest.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
End With
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

 

[clamont7]

This almost worked. The data that was returned was correct, but the "S-7" tab was already created and formatted, so there is no need to delete it and create a new one. Can this data be pasted to the already existing "S-7" worksheet?

 

[JoeMo]

This almost worked. The data that was returned was correct, but the "S-7" tab was already created and formatted, so there is no need to delete it and create a new one. Can this data be pasted to the already existing "S-7" worksheet?

You said it was a "new' sheet you wanted to add the data to so I assumed you wanted to create it. If you already have the sheet then remove these lines:

On Error Resume Next
Sheets("S-7").Delete
On Error GoTo 0
Sheets.Add after:=Sheets("Data Dump")
ActiveSheet.Name = "S-7"

 

[clamont7]

Sorry for my confusing wording, this worked great though! I was able to update the code so that I could run it on all product types. The only issue I'm running into now is that it's deleting everything after column D (contents and formatting)

 

[JoeMo]

Sorry for my confusing wording, this worked great though! I was able to update the code so that I could run it on all product types. The only issue I'm running into now is that it's deleting everything after column D (contents and formatting)

This should fix that issue:

Sub clamont7()
Dim Rsource As Range, Rdest As Range, V, i As Long, j As Long
Set Rsource = Sheets("Data Dump").Range("A2:D" & Sheets("Data Dump").Cells(Rows.Count, "A").End(xlUp).Row)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Sheets("S-7")
    Set Rdest = .Range("A9").Resize(Rsource.Rows.Count, Rsource.Columns.Count)
    Rdest.Value = Rsource.Value
    V = Rdest.Value
    For i = 1 To UBound(V, 1)
        If V(i, 1) <> "S-7" Then
            For j = 1 To UBound(V, 2)
                V(i, j) = ""
            Next j
        End If
    Next i
    Rdest.Value = V
    On Error Resume Next
    Rdest.SpecialCells(xlCellTypeBlanks).Cells.Delete
    On Error GoTo 0
End With
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

 

[Peter_SSs]

I was able to update the code so that I could run it on all product types.

If I have understood correctly, here is a way to copy each product code in bulk to its own sheet.

The assumptions that I have made are ..
- 'Data Dump' has a heading row
- All the rows in column A of data dump to to another sheet. That is, column A does not contain any rows that need to be skipped altogether.
- All the destination sheets exist and have no data in columns A:D from row 9 down

If any assumption is incorrect, a modification can be made if you give details.

BTW,
- about how many rows of data will Data Dump likely contain?
- about how many different product codes are there?

Test with a copy of your workbook.

Sub CopyData()
  Dim d As Object
  Dim a As Variant
  Dim i As Long, uba As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Data Dump")
    a = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value
    uba = UBound(a)
    For i = 1 To uba
      d(a(i, 1)) = Empty
    Next i
    For i = 1 To d.Count
      With .Range("A1").Resize(uba + 1)
        .AutoFilter Field:=1, Criteria1:=d.keys()(i - 1)
        If .SpecialCells(xlVisible).Count > 1 Then .Offset(1).Resize(uba, 4).Copy Destination:=Sheets(d.keys()(i - 1)).Range("A9")
      End With
    Next i
    .AutoFilterMode = False
  End With
End Sub

 

[clamont7]

This worked great! All of your assumptions were correct. The data dump ranges from 1000 to 5000. There were 5 product codes.

 

[clamont7]

If .SpecialCells(xlVisible).Count > 1 Then .Offset(1).Resize(uba, 4).Copy Destination:=Sheets(d.keys()(i - 1)).Range("A9")
[/code]

This line is actually giving me a "run time error 9: Subscript out of range". Does this have to do with cell A9 being hidden after filtering is done to the data dump

 

[Peter_SSs]

This line is actually giving me a "run time error 9: Subscript out of range".

The most likely cause of that error on that line is that there is a value in column A of Data Dump that is not exactly the same as an existing sheet name - which relates to a combination of my 2nd and 3rd assumptions.

To identify the exact problem follow these steps when you get the error, 'Debug' again and ..

1. In the vba window if you don't have the 'Locals' pane visible then on the menus: View - Locals Window
2. In the locals window, expand the 'd' variable
3. Hover over the 'i' towards the end of the highlighted line and the pop-up should tell you the value of 'i' at that moment
4. Suppose i=3 then in the Locals Window look at the value beside Item 3 and that will likely have a text value that does not match a sheet name.

Depending on the circumstance of that value we will have to amend the code.