Creating worksheets from data


New Member
Oct 11, 2011
So im supposed code a sub that creates a sheet for each unique category found in column b in the excel spread sheet I have. In these sheets i need to include the name and price of the product (in that category) in column A and B respectively. I should note that the product names are in column A and prices in C on my excel sheet.

There are other variables to this such as putting the product/price four rows down and titling each sheet / column but I wont bother anyone with this as I appreciate the fact you have read this far. I am stumped, and any help is appreciated. Thanks, heres what i have thus far.
Option Explicit

Sub Categorize()
    Dim nCategories As Integer
    Dim rowOffset As Integer
    Dim category As String
    Dim ws As Worksheet
    Dim isNewCategory As Boolean
    Dim product As String
    Dim price As Currency
    Dim colAWidth As Single
    Dim colBWidth As Single
    Dim topCell As Range
    Dim newSheet As Worksheet
    Set topCell = Worksheets("AllProducts").Range("A3")
    nCategories = 0
    rowOffset = 1

    ' Capture the column widths of columns A and C (to be used for columns A and B in new sheets).
    With Worksheets("AllProducts").Columns("A")
    .ColumnWidth = colAWidth
    End With
    With Worksheets("AllProducts").Columns("A")
    .ColumnWidth = colBWidth
    End With

    ' Go through all products until encountering a blank cell.
    Do Until topCell.Offset(rowOffset, 0).Value = ""
        ' Capture the information on this product.
        With topCell
            product =
            category =
            price =
        End With
        ' Check whether this is a new category (i.e., if there is already a sheet with its name).
        isNewCategory = True
        For Each ws In Worksheets

        ' If it's a new category, add a new sheet and enter labels, as well as the first row of data.
        If isNewCategory Then
            nCategories = nCategories + 1
            Worksheets.Add After:=Worksheets(nCategories)
            Set newSheet = ActiveSheet
            With newSheet

            End With
        ' Otherwise, just add the next row of data.
            With Worksheets(category).Range("A3").End(xlDown)

            End With
        End If
        ' Get ready for the next product.
        rowOffset = rowOffset + 1
    ' Activate the AllProducts sheet.
End Sub

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Hmm well it needs a lot of work. First thing you need to do, I think, is sort the table in your AllProducts sheet by column B, so all your categories are listed together.

Then you'll need a loop that samples the value of each cell in column B. If a sheet of that name exists (which will require a function, see below), copy product details to a new row in that sheet. If it doesn't, create the sheet (in theory this would work without sorting the table, but sorting is neater and it'll allow you to debug the code more easily when it goes wrong).

Try this on a test spreadsheet:

i = 3
Do Until IsEmpty(Sheets("AllProducts").Cells(i, 2))
    ProductCategory = Sheets("AllProducts").Cells(i, 2).Value

    If SheetExists(ProductCategory) Then
        With Worksheets(ProductCategory)
            .Cells(.Range("A65536").End(xlUp).Row + 1, 1).Value = Sheets("AllProducts").Cells(i, 2).Offset(0, -1).Value
            .Cells(.Range("B65536").End(xlUp).Row + 1, 2).Value = Sheets("AllProducts").Cells(i, 2).Offset(0, 1).Value
        End With
        Worksheets.Add.Name = ProductCategory
        With Worksheets(ProductCategory)
            .Range("A1").Value = Sheets("AllProducts").Cells(i, 2).Offset(0, -1).Value
            .Range("B1").Value = Sheets("AllProducts").Cells(i, 2).Offset(0, 1).Value
        End With
    End If
    i = i + 1

Public Function SheetExists(SheetName As String) As Boolean
    Dim ws As Worksheet
    SheetExists = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = SheetName Then SheetExists = True
    Next ws
End Function
Upvote 0
thank you for your response, it was very helpful. I have on more easy question though. Im trying to make a macro that toggles the source data on a chart. That is, if I create a button and click it, it changes between product data 1, and 2. So far I have:

    With ActiveChart
        If ActiveChart.SetSourceData Source:=Range("Sheet1!$B$4:$B$15")
             .SetSourceData Source:=Range("Sheet1!$c$4:$c$15")
            .SetSourceData Source:=Range("Sheet1!$c$4:$c$15")
    End If
    End With

To me, this naturally would work but it produces an error and I cant find a work-around.
Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back