Parsing data to sheets

[cuetipper]

What I would like to do is to read through column g and compare cell by cell to see if there is an existing worksheet in the workbook with named like it.
If so copy that entire row to that worksheet and if not create a new worksheet with that name copy the 1st row of the original worksheet and then add the search row to it.
So if I had a worksheet with 100 entries of ten items I would end up with 11 worksheets, the original and ten more each with ten lines in them from the cell criteria with the sheet named after that criteria.

I started something but wont run. Am I on the right path?



Sub Parse_Sheets()

lr = Range("A1").End(xlDown).Row
'Get Vendor name
For ds = lr To 2 Step -1
shtn = Cells(ds, 7).Value
Rows(ds).Copy
'check existnce of sheet
For Each ws In ThisWorkbook.Worksheets
awsn = ActiveSheet.Name
If awsn <> shtn Then
activesheetname = shtn
Rows(ds).Paste
Sheets(Data).Select
Else
Sheets.Add
activesheetname = shtn
Rows(ds).Paste
Sheets(Data).Select
n1:
Next ds
End Sub

 

[Fluff]

If None of the sheets already exist try

Sub CopyFltr()
   Dim Cl As Range
   Dim ws As Worksheet
   
   Application.ScreenUpdating = False
   Set ws = Sheets("[COLOR=#ff0000]Data[/COLOR]")
   
   If ws.AutoFilterMode Then ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each Cl In ws.Range("G2", ws.Range("G" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) Then
            Sheets.Add.Name = Cl.Value
            .Add Cl.Value, Nothing
            ws.Range("[COLOR=#ff0000]A1:Z1[/COLOR]").AutoFilter 7, Cl.Value
            ws.AutoFilter.Range.Copy Sheets(Cl.Value).Range("A1")
         End If
      Next Cl
   End With
   ws.AutoFilterMode = False
End Sub

Change sheet name & range in red to suit.
If someof the sheets already exist let me know.

 

[cuetipper]

Fluff,
Thanks for the quick response. I ran your code and keep gettin a Complie error Wrong # of arguments on line Set ws = sheets("data") it highlight sheets.

 

[Fluff]

In that case you probably have a variable or a sub named Sheets, or possible ws

 

[ParamRay]

Here's an alternative macro for you. Just remember to change the name of the sheet containing the source data (as indicated in the second line of code):

Public Sub CopyData()
  Const strSOURCE_SHEET = "Source Data" ' <-- Set name of source data sheet here
  Dim avntHeaders() As Variant
  Dim avntCopyRow() As Variant
  Dim strCellText As String
  Dim lngNextRow As Long
  Dim lngLastRow As Long
  Dim intLastCol As Integer
  Dim wksSource As Worksheet
  Dim wksTarget As Worksheet
  Dim j As Long
  
  On Error GoTo ErrorHandler
  Set wksSource = ThisWorkbook.Sheets(strSOURCE_SHEET)
  lngLastRow = wksSource.Cells(wksSource.Rows.Count, "G").End(xlUp).Row
  intLastCol = wksSource.Cells(1, wksSource.Columns.Count).End(xlToLeft).Column
  avntHeaders = wksSource.Cells(1, "A").Resize(1, intLastCol).Value
  
  For j = 2 To lngLastRow
    strCellText = wksSource.Cells(j, "G").Text
    On Error Resume Next
    Set wksTarget = ThisWorkbook.Worksheets(strCellText)
    
    On Error GoTo ErrorHandler
    If wksTarget Is Nothing Then
      Set wksTarget = ThisWorkbook.Worksheets.Add
      wksTarget.Name = strCellText
      wksTarget.Cells(1, "A").Resize(1, intLastCol).Value = avntHeaders
      lngNextRow = 2
    Else
      lngNextRow = wksTarget.Cells(wksTarget.Rows.Count, "G").End(xlUp).Row + 1
    End If
    
    avntCopyRow = wksSource.Cells(j, "A").Resize(1, intLastCol).Value
    wksTarget.Cells(lngNextRow, "A").Resize(1, intLastCol).Value = avntCopyRow
    Set wksTarget = Nothing
  Next j
  
  MsgBox Format(lngLastRow - 1, "#,0") & " row(s) were copied.", vbInformation
  Exit Sub
  
ErrorHandler:
  MsgBox Err.Description, vbExclamation
End Sub

 

[cuetipper]

Actually I was playing around a bit with it and it runs fine changing the sheets to worksheets. Very fast. Thanks so much this is awesome.
A small favor. the new sheets are being added to the front of the initial sheet. Is it possible to have them created after - so the original is always the first sheet?

 

[ParamRay]

Actually I was playing around a bit with it and it runs fine changing the sheets to worksheets. Very fast. Thanks so much this is awesome.
A small favor. the new sheets are being added to the front of the initial sheet. Is it possible to have them created after - so the original is always the first sheet?

Which macro, mine or Fluff's? Mine is faster by the way...

 

[Fluff]

Actually I was playing around a bit with it and it runs fine changing the sheets to worksheets. Very fast. Thanks so much this is awesome.
A small favor. the new sheets are being added to the front of the initial sheet. Is it possible to have them created after - so the original is always the first sheet?

Just make this change

            Sheets.Add[COLOR=#ff0000](, Sheets(1))[/COLOR].Name = Cl.Value

Which macro, mine or Fluff's? Mine is faster by the way...

Not on my test sheet, yours is 1.7 seconds mine is 0.7 seconds

 

[ParamRay]

Just make this change

            Sheets.Add[COLOR=#ff0000](, Sheets(1))[/COLOR].Name = Cl.Value

Not on my test sheet, yours is 1.7 seconds mine is 0.7 seconds

And on large datasets (100,000+ rows) mine is definitely faster.

 

[Fluff]

Beg to differ, I very rarely use error handlers.
I could also criticise elements of your code, but (IMO) that's not the purpose of this board.
Also, I don't make inaccurate claims about my code vs somebody else's.