Link to home
Start Free TrialLog in
Avatar of K B
K BFlag for United States of America

asked on

Excel Macro: Correct Macro that creates tabs for each "AccountSku"

The Macro c
This Macro works great unless it hits one or more of these three problems

1. The tab with all the data is not named Sheet1 (could this instead be the in focus tab?).
2. There are no users with the AccountSku assigned
3. The AccountSku was not identified (it is blank)

Sub createsheetabs()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim rng As Range, cell As Range
    Dim ws As Worksheet, lrow As Long, wk As Worksheet
    Dim lr As Long, ws1 As Worksheet, srow As Long
    Dim i As Long

    Set ws = Sheets("Sheet1")

    For Each wk In ActiveWorkbook.Worksheets
        If wk.Name <> ws.Name Then wk.Delete

    Next wk

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("C1:C" & lrow)

    For Each cell In rng

        If InStr(1, cell.Value, "AccountSku", vbTextCompare) > 0 Then

        If Not ws1 Is Nothing Then ws1.Name = ws1.Name & "-" & i

            Sheets.Add after:=Sheets(Sheets.Count)

                ActiveSheet.Name = Left(cell.Offset(1, 0).Value, 25)


            Set ws1 = ActiveSheet
            cell.EntireRow.Copy ws1.Range("a1")
            i = 0

        Else
            lr = ws1.Cells(Cells.Rows.Count, "c").End(xlUp).Row + 1
            cell.EntireRow.Copy ws1.Range("A" & lr)
            ws1.Cells.EntireColumn.AutoFit
            i = i + 1
        End If

    Next cell

     If Not ws1 Is Nothing Then ws1.Name = ws1.Name & "-" & i

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Open in new window


I was hoping to amend the Macro so that the script works properly and these 3 issues are resolved with a good solution.

Here are screenshots to illustrate the Excel file that it manipulates (it starts with a single tab and the first screenshot shows how it creates the other tabs with the AccountSku and number of users with it assigned). You can see how the script failed and stopped on line 191/192 - instead of the name of the Sku it found "AccountSku" again.  I would prefer it not create a tab in that case and move to line 192 please.

User generated image
User generated image

Thank you.
Avatar of Norie
Norie

The first one is easy.

If you want the code to work on the active sheet change this,
Set ws = Sheets("Sheet1")

Open in new window

to this.
Set ws = ActiveSheet

Open in new window


As for the other two, they  aren't particularly clear, to me anyway.

Could you upload a sample workbook?
Avatar of K B

ASKER

Here is an example of Problem #2 & #3

ee_sample2.xlsx

ee_sample-3.xlsx
ASKER CERTIFIED SOLUTION
Avatar of Ejgil Hedegaard
Ejgil Hedegaard
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of K B

ASKER

Perfect thank you!