Code to Delete Sheet Tabs

[Justinian]

I have a code I run to split data into tab named after managers. All managers are together on sheet1 and after I run the code, each manager's data is on its own tab. The problem is the when the code is run again, it adds data on each tab instead of replacing the data on each tab. How can I construct some code so Excel deletes all tabs to the right of my data sheet before running my original code to separate tabs?

 

[Justinian]

This works but it is making a tab of all names, not just the names in column H. Also, I need to code to run when the Run Macro tab is selected. This is because I installed a button to run the macro to make it easier for others to use.

 

[Justinian]

Make sure that the "All Accounts" sheet is the active sheet and try this macro:

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomG As Long
    bottomG = Range("G" & Rows.Count).End(xlUp).Row
    Dim c As Range
    Dim ws As Worksheet
    If Sheets("All Accounts").FilterMode Then Sheets("All Accounts").ShowAllData
    For Each c In Range("G2:G" & bottomG)
        If c <> "" Then
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(c.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
                Sheets("All Accounts").Range("A1:N" & bottomG).AutoFilter Field:=7, Criteria1:=c
                Sheets("All Accounts").Range("A1:N" & bottomG).SpecialCells(xlCellTypeVisible).EntireRow.Copy ActiveSheet.Cells(1, 1)
                ActiveSheet.Columns.AutoFit
            Else
                Sheets(c.Value).UsedRange.ClearContents
                Sheets("All Accounts").Range("A1:N" & bottomG).AutoFilter Field:=7, Criteria1:=c
                Sheets("All Accounts").Range("A1:N" & bottomG).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(c.Value).Cells(1, 1)
                Sheets(c.Value).Columns.AutoFit
            End If
            If Sheets("All Accounts").FilterMode Then Sheets("All Accounts").ShowAllData
        End If
    Next c
    Application.ScreenUpdating = True
 End Sub

This works but it is making a tab of all names, not just the names in column H. Also, I need to code to run when the Run Macro tab is selected. This is because I installed a button to run the macro to make it easier for others to use.

 

[Justinian]

It does transfer over the formatting I need once the data clears so this is getting me closer. All I need is to create tabs for only the names on column H.

 

[mumps]

Assign this macro to your "Execute" button and then click it.

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomH As Long
    bottomH = Sheets("All Accounts").Range("H" & Rows.Count).End(xlUp).Row
    Dim c As Range
    Dim ws As Worksheet
    If Sheets("All Accounts").FilterMode Then Sheets("All Accounts").ShowAllData
    For Each c In Sheets("All Accounts").Range("H2:H" & bottomH)
        If c <> "" Then
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(c.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
                Sheets("All Accounts").Range("A1:N" & bottomH).AutoFilter Field:=8, Criteria1:=c
                Sheets("All Accounts").Range("A1:N" & bottomH).SpecialCells(xlCellTypeVisible).EntireRow.Copy ActiveSheet.Cells(1, 1)
                ActiveSheet.Columns.AutoFit
            Else
                Sheets(c.Value).UsedRange.ClearContents
                Sheets("All Accounts").Range("A1:N" & bottomH).AutoFilter Field:=8, Criteria1:=c
                Sheets("All Accounts").Range("A1:N" & bottomH).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(c.Value).Cells(1, 1)
                Sheets(c.Value).Columns.AutoFit
            End If
            If Sheets("All Accounts").FilterMode Then Sheets("All Accounts").ShowAllData
        End If
    Next c
    Application.ScreenUpdating = True
 End Sub

 

[My Aswer Is This]

I'm moving on to some other thread. Looks like you have a lot of help here.

 

[Justinian]

I'm moving on to some other thread. Looks like you have a lot of help here.

Thank you for your help!

 

[Justinian]

Assign this macro to your "Execute" button and then click it.

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomH As Long
    bottomH = Sheets("All Accounts").Range("H" & Rows.Count).End(xlUp).Row
    Dim c As Range
    Dim ws As Worksheet
    If Sheets("All Accounts").FilterMode Then Sheets("All Accounts").ShowAllData
    For Each c In Sheets("All Accounts").Range("H2:H" & bottomH)
        If c <> "" Then
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(c.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
                Sheets("All Accounts").Range("A1:N" & bottomH).AutoFilter Field:=8, Criteria1:=c
                Sheets("All Accounts").Range("A1:N" & bottomH).SpecialCells(xlCellTypeVisible).EntireRow.Copy ActiveSheet.Cells(1, 1)
                ActiveSheet.Columns.AutoFit
            Else
                Sheets(c.Value).UsedRange.ClearContents
                Sheets("All Accounts").Range("A1:N" & bottomH).AutoFilter Field:=8, Criteria1:=c
                Sheets("All Accounts").Range("A1:N" & bottomH).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(c.Value).Cells(1, 1)
                Sheets(c.Value).Columns.AutoFit
            End If
            If Sheets("All Accounts").FilterMode Then Sheets("All Accounts").ShowAllData
        End If
    Next c
    Application.ScreenUpdating = True
 End Sub

Right on the money. Thank you all (Mumps, Mark, and Myaswer) for your help!

 

[My Aswer Is This]

Glad we were able to help you. Come back here to Mr. Excel next time you need additional assistance.

Right on the money. Thank you all (Mumps, Mark, and Myaswer) for your help!

 

[Justinian]

One more question. I wanted a list of unique names from the All Accounts tab. I created a dynamic range and there are not that many but when I run the macro, it slows down considerably. When I delete the dynamic range, the macro runs perfectly. How could only forty cells filled with this formula slow down the macro that much?

=IFERROR(INDEX(Managers,MATCH(0,INDEX(COUNTIF($AD$1:AD3,Managers),0,0),0)),"")

When the macro runs, in the lower right hand corner it says "Calculating: (4 processor(s)).

 

[MARK858]

Try changing

Application.ScreenUpdating = False

to

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

and

Application.ScreenUpdating = True

to

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With