Macro to create new tabs based on list

[Gimics]

Hello,

I think this is a pretty big ask... but maybe people can just chime in on pieces and we can build from there?

I have a worksheet with headings in row 7, a list of customers in column A, lists of products each customer sells in column B, and monthly sales information from columns C to N. The number of customers and products (ie. rows) will be volatile, but the number of months (ie. columns) will always be 14.

I would like to be able to run a macro to help out with the following:

• Create tabs for each unique customer value
• Copy and paste the headers and all of the information for that customer (columns A through N) to the new tab
• Create a linked (to each tab) summary tab of the totals, by month, for each customer
• Create a linked (to each tab) summary tab of the totals, by month, for each product

The sheet would be continually updated, so it would make sense if each time the macro was run, the information was wiped and recreated.

Thanks for any help - I have little experience with coding or vba, so anything is much appreciated.

 

[dmt32]

Hi,
I created code below in response to others here having similar requirements. The linking part you will need to figure but following code should do most of what you want.

Copy both procedures (Function is stock code) to a standard module. When run, an inputbox appears. With mouse, select the required field heading (Customer?) you want to create separate tabs for and cell address will show in Inputbox. Press Ok & sheets for each customer will be created (if one does not already exist) or cleared to refresh data each time code is run. Code is dynamic and will adjust to number rows / columns in your master sheet.

Option Explicit


Sub FilterData()
    Dim ws1Master As Worksheet, wsNew As Worksheet, wsFilter As Worksheet
    Dim Datarng As Range, FilterRange As Range, objRange As Range
    Dim rowcount As Long
    Dim colcount As Integer, FilterCol As Integer, FilterRow As Long
    Dim SheetName As String




    'master sheet
    Set ws1Master = ActiveSheet


    'set the Column you
    'are filtering
top:
    On Error Resume Next
    Set objRange = Application.InputBox("Select Field Name To Filter", "Range Input", , , , , , 8)
    On Error GoTo 0
    If objRange Is Nothing Then
        Exit Sub
    ElseIf objRange.Columns.Count > 1 Then
        GoTo top
    End If


    FilterCol = objRange.Column
    FilterRow = objRange.Row


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With


    On Error GoTo progend


    'add filter sheet
    Set wsFilter = Sheets.Add
    With ws1Master
        .Activate
        .Unprotect Password:=""  'add password if needed
        
        rowcount = .Cells(.Rows.Count, FilterCol).End(xlUp).Row
        colcount = .Cells(FilterRow, .Columns.Count).End(xlToLeft).Column


        If FilterCol > colcount Then
            Err.Raise 65000, "", "FilterCol Setting Is Outside Data Range.", "", 0
        End If


        Set Datarng = .Range(.Cells(FilterRow, 1), .Cells(rowcount, colcount))
        'extract Unique values from FilterCol
        .Range(.Cells(FilterRow, FilterCol), _
               .Cells(rowcount, _
                      FilterCol)).AdvancedFilter _
                      Action:=xlFilterCopy, _
                      CopyToRange:=wsFilter.Range("A1"), _
                      Unique:=True
        rowcount = wsFilter.Cells(wsFilter.Rows.Count, "A").End(xlUp).Row
        'set Criteria
        wsFilter.Range("B1").Value = wsFilter.Range("A1").Value


        For Each FilterRange In wsFilter.Range("A2:A" & rowcount)
            'check for blank cell in range
            If Len(FilterRange.Value) > 0 Then
                'add the FilterRange to criteria
                wsFilter.Range("B2").Value = FilterRange.Value
                SheetName = RTrim(Left(FilterRange.Value, 31))
                'if FilterRange sheet exists
                'update it
                If SheetExists(SheetName) Then
                    Sheets(SheetName).Cells.Clear
                Else
                    'add new sheet
                    Set wsNew = Sheets.Add(after:=Worksheets(Worksheets.Count))
                    wsNew.Name = SheetName
                End If
                Datarng.AdvancedFilter Action:=xlFilterCopy, _
                                       CriteriaRange:=wsFilter.Range("B1:B2"), _
                                       CopyToRange:=Sheets(SheetName).Range("A1"), _
                                       Unique:=False


            End If
        Next
        .Select
    End With


progend:
    wsFilter.Delete
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    If Err > 0 Then
        MsgBox (Error(Err)), 16, "Error"
        Err.Clear
    End If
End Sub


Function SheetExists(ByVal sh As String) As Boolean
    On Error Resume Next
    SheetExists = CBool(Len(Worksheets(sh).Name) > 0)
    On Error GoTo 0
End Function

Hope Helpful

Dave

 

[Gimics]

Dave! That's incredible... and very fast! This did exactly what I wanted, without changing anything.

Now... part two - the summary sheets. The idea with these is that, after each unique tab is created, I would like to be able to manually change the values in that tab, and then have a summary sheet that would update and reflect the manual changes (this can't occur on the first data sheet, as it is actually a pivot table linked to a cube!):

• Create a linked (to each tab) summary tab of the totals, by month, for each customer
• Create a linked (to each tab) summary tab of the totals, by month, for each product

For the customer sheet, this would require totaling each tab, by month. For the product sheet... this would likely require a lookup for the product on each tab (there will only be unique values) and returning the sum of that product from each tab. I'm fine if the summary sheets are all pasted values, with the macro doing all of the math too (instead of creating indexing formulas), but whatever is easiest!

 

[dmt32]

Dave! That's incredible... and very fast! This did exactly what I wanted, without changing anything.

Like I said, I developed the code in response to many requests posted here to do what you wanted.

The linking bit is not something I can assist without seeing copy of your workbook with some sample data. If you can place copy in a public dropbox & provide link I or others on this board maybe able to assist.

Dave

 

[Gimics]

Let's see if this works:

https://drive.google.com/file/d/0B2xhyNpY14qET1NsWmYzU2dSOUE/edit?usp=sharing

My sheet would have a volatile number of tabs, with a volatile number of customers and products on each. I also noticed that not all months are listed, but this could be up to 12 months of data.

The summary sheets illustrate the results (with formulas) based on the example information in the worksheet.

 

[Gimics]

Let's see if this works:

...with a volatile number of customers and products on each.

I meant to just say products... there would only be one customer per tab, obviously. But the number of tabs is volatile, and therefore the total number of customers would be too. These would both be based on columns A and columns B of the first pivot table worksheet, that the original macro is using to create the tabs.