VBA to create new tab on base on an identifier

[Obwan]

I am hoping one of you VBA gurus can help me with a script to separate rows of data into multiple sheets in a workbook.
The data is in 5 columns over 1000s of rows for many customers. I cannot export the data any other way.
Column A has:

• 0 (zero) - Header row to show the change from one customer’s information to the next.
• A – sub header
• B – detail

On the row where 0 is in column 1, the customer name is in column B.
What I want is to create a new tab for each customer. I need a script which…. Each time it finds a 0 in column A it takes the rows of data and copies it to a new tab and renames the tab the code in column B of the header line. The script stops at the next 0 and runs again.
I can do this manually by copying and pasting but there are 100s. I am trying (with your help) make life easier for our sales team.
Any help will be gratefully received. Thank you for taking to the time to reads this.
Regards
Obwan

 

[Logit]

.
Here is one method :

Option Explicit


Sub CreateSheets()


    Dim Cell    As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet


        Set RngBeg = Worksheets("Sheet1").Range("B2")
        Set RngEnd = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)


        ' Exit if the list is empty.
        If RngEnd.Row < RngBeg.Row Then Exit Sub
Application.ScreenUpdating = False
        For Each Cell In Worksheets("Sheet1").Range(RngBeg, RngEnd)
            On Error Resume Next
                ' No error means the worksheet exists.
                Set Wks = Worksheets(Cell.Value)


                ' Add a new worksheet and name it.
                If Wks.Name <> Cell.Value Then
                    Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    Wks.Name = Cell.Value
                End If
            On Error GoTo 0
        Next Cell
Application.ScreenUpdating = True
MakeHeaders
End Sub


Sub MakeHeaders()
Dim srcSheet As String
Dim dst As Integer
srcSheet = "Sheet1"
Application.ScreenUpdating = False
For dst = 1 To Sheets.Count
    If Sheets(dst).Name <> srcSheet Then
    Sheets(srcSheet).Rows("1:1").Copy
    Sheets(dst).Activate
    Sheets(dst).Range("A1").PasteSpecial xlPasteValues
    'ActiveSheet.PasteSpecial xlPasteValues
    Sheets(dst).Range("A1").Select
    End If
Next
Application.ScreenUpdating = True
CopyData
End Sub


Sub CopyData()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
On Error GoTo M
Lastrow = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
Dim ans As String
    For i = 2 To Lastrow
    ans = Sheets("Sheet1").Cells(i, 2).Value
        Sheets("Sheet1").Rows(i).Copy Sheets(ans).Rows(Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1)
    Next
Application.ScreenUpdating = True


Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A1").Select


Exit Sub


M:
MsgBox "No such sheet as  " & ans & " exist"
Application.ScreenUpdating = True


End Sub

 

[Obwan]

Wow, that was so quick. Thank you.

 

[Logit]

.
You are welcome.

 

[Obwan]

I just ran a test on small amount of data. It didn’t quite work out. I can see the how it would work but I think my failure to give you a sample didn’t help (sorry).
When I ran the scripts the result was dozens of tabs with 1 line of data on each.
I made up this dummy data to show you how it looks. There are usually about 300 lines per customer, with several sub headings. This example should result in 4 tabs.

0	Customer1			6/09/2019
A	Stationery		Price	RRP
B	111111	Pen	$ 1.20	$ 1.50
B	222222	Paper	$ 2.00	$ 2.75
A	Furniture
B	333333	Desk	$ 129.61	$ 200.00
0	Customer2			6/09/2019
A	Stationery		Price	RRP
B	111111	Pen	$ 1.20	$ 1.50
B	222222	Paper	$ 2.00	$ 2.75
A	Furniture
B	333333	Desk	$ 150.00	$ 200.00
0	Customer3			6/09/2019
A	Stationery		Price	RRP
B	111111	Pen	$ 1.10	$ 1.50
B	222222	Paper	$ 1.75	$ 2.75
A	Furniture
B	333333	Desk	$ 115.00	$ 200.00
B	Customer4			6/09/2019
A	Stationery		Price	RRP
B	111111	Pen	$ 1.20	$ 1.50
B	222222	Paper	$ 1.90	$ 2.75
A	Furniture
B	333333	Desk	$ 160.00	$ 200.00

<tbody>
</tbody>

 

[Akuini]

B

Customer4

6/09/2019

<tbody>
</tbody>

Why Customer4 has B not 0?

 

[Akuini]

I don’t quite understand what you want but maybe this:
The code will creates multiple sheets, each will be named by each customer.
It copies all data from each customer to the new sheet accordingly.
If this is not what you expect then please explain in more detail. What is the result should look like (for example for customer1)?

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1109080a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1109080-vba-create-new-tab-base-identifier.html#post5337942[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] ws [COLOR=Royalblue]As[/COLOR] Worksheet
[COLOR=Royalblue]Dim[/COLOR] va
[COLOR=Royalblue]Dim[/COLOR] wsName [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]Set[/COLOR] ws = ActiveSheet

[COLOR=Royalblue]With[/COLOR] ws
va = .Range([COLOR=brown]"A1"[/COLOR], .Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    
    [COLOR=Royalblue]If[/COLOR] va(i, [COLOR=crimson]1[/COLOR]) = [COLOR=brown]"0"[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        
        j = i
            [COLOR=Royalblue]Do[/COLOR]
                i = i + [COLOR=crimson]1[/COLOR]
                [COLOR=Royalblue]If[/COLOR] i > UBound(va, [COLOR=crimson]1[/COLOR]) [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]Do[/COLOR]
            [COLOR=Royalblue]Loop[/COLOR] [COLOR=Royalblue]While[/COLOR] va(i, [COLOR=crimson]1[/COLOR]) <> [COLOR=brown]"0"[/COLOR]
        i = i - [COLOR=crimson]1[/COLOR]
        
        wsName = .Cells(j, [COLOR=brown]"B"[/COLOR])
        [COLOR=Royalblue]Set[/COLOR] c = .Range(.Cells(j, [COLOR=brown]"A"[/COLOR]), .Cells(i, [COLOR=brown]"E"[/COLOR]))
            
            [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] Evaluate([COLOR=brown]"ISREF('"[/COLOR] & wsName & [COLOR=brown]"'!A1)"[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
                 Sheets.Add(after:=Sheets(Sheets.count)).Name = wsName
                 c.Copy Range([COLOR=brown]"A1"[/COLOR])
                 Columns([COLOR=brown]"A:E"[/COLOR]).AutoFit
            [COLOR=Royalblue]Else[/COLOR]
                 MsgBox [COLOR=brown]"Sheet's name already exist?"[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
       
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
[COLOR=Royalblue]Next[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[Obwan]

The result is exactly what I wanted. Thank you Akuini. This is going to save me days of work.
Appreciate the help you and Logit have given.
I apologise for my poor explanation, I do try to explain correctly but seem to miss the little but important facts.
Regards
Olwyn

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.

 

[Logit]

.
Glad you have a solution.