Auto-create and name a new tab, and carry relevant data to new tab, from a master sheet

[teenyjem]

I have a spreadsheet, that has been created, and the cells are unlikely to move location, so would now like to impose a macro onto it.

It is a master sheet, and I need it broken into tabbed sheets, whenever there is a change in both the CUSTOMER NAME and COUNTRY. I wish to keep the master sheet at the front of the list.

I have created an example of the cells, and stripped out any irrelevant data; keeping only the Customer Name and Country in.
Please view the sheet attached: all data.xls

This needs to break out into additional tabs, named after firstly the country, then customer name. Can we limit it to max fifteen characters country name and max ten characters customer name, with an auto " - " in between?

i.e. - this should create 6 tabs - labelled:
England - David, France - Tom, France - Fred, Germany - Matthew, USA - Michael, USA - Fred

Can anyone help?

Thank you
Tina

[teenyjem]

Can anyone help with my request?

[ragulduy]

Sub macro_1()
Dim count, ws1, ws2
Set ws1 = Sheets("Sales")
count = 2
Do Until ws1.Range("K" & count) = ""
    If Not ws1.Range("K" & count) = ws1.Range("K" & count - 1) _
        Or Not ws1.Range("T" & count) = ws1.Range("T" & count - 1) Then
        Set ws2 = Sheets.Add(After:=Sheets(Sheets.count))
        ws2.Name = Left(ws1.Range("T" & count), 15) & " - " & Left(ws1.Range("K" & count), 10)
    End If
    ws1.Rows(count).Copy ws2.Rows(Range("A" & Rows.count).End(xlUp).Row + 1)
    count = count + 1
Loop
End Sub

[Mumps1]

Another approach:

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomT As Integer
    bottomT = Range("T" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim ws As Worksheet
    For Each rng In Range("T2:T" & bottomT)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(Left(rng.Value, 15) & "-" & Left(rng.Offset(0, -9), 10))
        On Error GoTo 0
        If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Left(rng.Value, 15) & "-" & Left(rng.Offset(0, -9), 10)
        End If
    Next rng
    Application.ScreenUpdating = True
 End Sub

[teenyjem]

Thank you for the very prompt reply.
Couple of questions:
1, this does not create a title line on each new tab. Can you tell me how to get this to appear?
2, this does work on the sheet, but when i apply it to my actual copy of the real data i am getting: "Run--time error '9': Subscript out of range" - do you know why? (Note, my spreadsheet averages a few hundred lines with multiple countries and customers per country - as well as the table titles being different.

Thanks very much.

[AB33]

Try the attached.

[AB33]

There are 3 codes. Which code you are referring to?

[teenyjem]

Feedback on post #5-

On my real sheet and the test sheet: this is creating multiple tabs but each new tab is empty. Maybe I should have been clearer in that i want to duplicate the relevant lines (ie, carry over the detail of that particular country and customer) - sorry - my bad! But yeh, that looks good apart from the missing data - and it is working on my (REAL) sheet the same.

[teenyjem]

Feedback on post #4:
I copy your code and put it into my sheet and it just gets rid of all data. Whole page goes blank and no tabs are created.

[teenyjem]

Ah! At time of posting, i was referring to post #3 - let me try the others and provide some feedback! Thank you!

[ragulduy]

Sub macro_1()
Dim count, ws1, ws2
Set ws1 = Sheets("Sales")
count = 2
Do Until ws1.Range("K" & count) = ""
    If Not ws1.Range("K" & count) = ws1.Range("K" & count - 1) _
        Or Not ws1.Range("T" & count) = ws1.Range("T" & count - 1) Then
        Set ws2 = Sheets.Add(After:=Sheets(Sheets.count))
        ws2.Name = Left(ws1.Range("T" & count), 15) & " - " & Left(ws1.Range("K" & count), 10)
        ws1.rows(1).copy ws2.rows(1)
    End If
    ws1.Rows(count).Copy ws2.Rows(Range("A" & Rows.count).End(xlUp).Row + 1)
    count = count + 1
Loop
End Sub

Will include the header on all the created tabs, I'm not sure about the error, I only tested it on your workbook. What line of code do you get the error on? What is the value of count at that point and what is the data of that row of your workbook? Any more information would also help

[AB33]

On you real data, one of the columns may be empty, hence for creating empty tabs.
If column T is blank, the code skips that row.
Could you please show me how are the empty tabs have been created?

[ragulduy]

@AB33: I think they were referring to Mumps' code with regards to empty tab, that code created the tabs but didn't copy the data across.

[AB33]

Yudlugar,
Thank you for re-minder! I think I mixed-up the # numbers.
My code works on sheet "Sales".
You need to change the name of the sheet "Sales" in your actual "master Sheet". I am also assuming that you do not have any other sheets. The code clears any existing tab except the sales tab(In your actual data the name of the master sheet) and repopulate the tabs with fresh data.

[teenyjem]

Ah ok - thanks all. I am just updating with what i work from.
I will rename the tabs as neccessary and try this again.

you are correct in the way that some cells are empty. this is a copy of the data i am working with, hiding the appropriate data.

modded all data.xlsx

this is a more up to date sheet.

thanks to all for efforts thus far - greatly appreciated!

[Mumps1]

Try this code. It will copy your header line and all the relevant lines.

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomT As Integer
    bottomT = Range("T" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim rgn2 As Range
    Dim ws As Worksheet
    For Each rng In Range("T2:T" & bottomT)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(Left(rng.Value, 15) & "-" & Left(rng.Offset(0, -9), 10))
        On Error GoTo 0
        If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Left(rng.Value, 15) & "-" & Left(rng.Offset(0, -9), 10)
                Sheets("All data mod new").Range("A1:AH1").Copy ActiveSheet.Cells(1, 1)
                For Each rng2 In Sheets("All data mod new").Range("T2:T" & bottomT)
                    If Left(rng2.Value, 15) & "-" & Left(rng2.Offset(0, -9), 10) = ActiveSheet.Name Then
                        rng2.EntireRow.Copy ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                    End If
                Next rng2
        End If
    Next rng
    Application.ScreenUpdating = True
 End Sub

[AB33]

Updated code.

[teenyjem]

Just tried against #11 - wow - it works fantastico! thank you!!!
it was the naming of my tab as 'sales' that did it! thank u! i will run again in the morning and if this is all sorted, will mark as closed! thank you to all!