Creating worksheets from data

[Madhadda]

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

        Next
        
        ' 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.
        Else
            With Worksheets(category).Range("A3").End(xlDown)

            End With
        End If
        
        ' Get ready for the next product.
        rowOffset = rowOffset + 1
    Loop
    
    ' Activate the AllProducts sheet.
    Worksheets("AllProducts").Activate
End Sub

 

[squidgeny]

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
    Else
        Worksheets.Add.Name = ProductCategory
        Sheets("AllProducts").Activate
        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
Loop

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

 

[Madhadda]

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:

ActiveSheet.ChartObjects("SalesChart").Activate
    With ActiveChart
    
        If ActiveChart.SetSourceData Source:=Range("Sheet1!$B$4:$B$15")
             .SetSourceData Source:=Range("Sheet1!$c$4:$c$15")
    Else
            .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.