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

clamont7

New Member
Joined
Aug 31, 2018
Messages
15
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!
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,746
This will create the new sheet called "S-7".
Rich (BB code):
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

New Member
Joined
Aug 31, 2018
Messages
15
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

MrExcel MVP
Joined
May 26, 2009
Messages
16,746
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

New Member
Joined
Aug 31, 2018
Messages
15
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

MrExcel MVP
Joined
May 26, 2009
Messages
16,746
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:
Rich (BB code):
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
44,443
Office Version
365
Platform
Windows
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.

Rich (BB code):
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

New Member
Joined
Aug 31, 2018
Messages
15
This worked great! All of your assumptions were correct. The data dump ranges from 1000 to 5000. There were 5 product codes.
 

clamont7

New Member
Joined
Aug 31, 2018
Messages
15
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
44,443
Office Version
365
Platform
Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,095,816
Messages
5,446,664
Members
405,413
Latest member
AlainCar

This Week's Hot Topics

Top