Move rows to another sheet based on criteria and rename sheet based on data

[Matheson843]

Hi

The code posted by texaslynn in the link below works perfectly for the beginning of what I'm trying to do. However, I already have a tab with a name that matches one of the data names in the column that is being broken out. When the macro runs, the already created tab is overwritten with the data that is being broken out from the selected column.

My question: Is there a way to break out data based on what is in column "A". While naming the new sheet the same as the data but with a variant such as (2) or (a) at the end of the name.


Example: I already have a tab for "Ford" however I am trying to break out the data into new sheets based on column A "Cars." When I run your macro the pre-existing "Ford" tab is overwritten by the data broken out from column A "Cars." I would like to be able to break the data in column A "Cars" into tabs such as "Ford(a)" or "Ford(2)" so that the data doesn't overwrite. Is this possible? Thanks in advance!!!

Here is a link to the similiar post: http://www.mrexcel.com/forum/excel-...s-move-rows-another-sheet-based-criteria.html

Cars	Price	Year	Color
Ford	30K	2011	Blue
Chevy	38K	2013	Green
Ferrari	60K	2012	Red
Nissan	40K	2010	Red
Toyota	25K	2011	Black
Honda	26K	2010	White

<TBODY>
</TBODY>

 

[healey21]

I have tested this code, I am not the creator but I have only adjusted it to add the number 1 to each sheet it creates based on the vehicle name, the code came from this website: How to split data into multiple worksheets based on column in Excel?

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 1
Set ws = Sheets("Master")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:D1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & "" & "1" Else Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)

ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

 

[Matheson843]

Thanks!! I didn't use the full code but parts of it helped to manipulate texaslynns original code to breakout the projects by #. This was a huge help though, thanks!!