Macro to Copy rows between two values

[rayg]

Hi,
I need help writing a macro which will create new worksheets by copying contents from another worksheet (say "Master")

The worksheet "Master" has a report for various products

Row 1 column A value : Product 1
product 1 details...row 2 ...x
(details about the product 1 with no mention of the the product name)

Row X + 1, Column A value :Product 2

product 2 details rows x +2..y

and so on


I need to copy the product 1 values into a worksheet "Product1" and product 2 values into worksheet into "Product2" and so on..



Appreciate any help!

 

[Ralajer]

Welcome to the board rayg.

Let me know if I am understanding your problem correctly.

The Master sheet contains a list of product names with associated product details which are in the same column as the product names but on subsequent rows. If that is the case are there a fixed number of rows containing details or does that vary for each product? You then want to have the macro copy all the Product names and details to a new worksheet name based on the product name.

Thanks

 

[rayg]

Thanks Rob.

The product name is in the first column and the details span multiple columns and rows.. The row and column count is not not fixed. It varies for each product (anywhere between 1 to 1000 rows)

 

[Ralajer]

Just another few questions. Are the only values in Column A product names with blanks between them? If no, is there a index of product names without product details on another sheet?

 

[rayg]

Hi Rob,
Column A has details of the product too.

E.g.

Col A Col B Col C Col D .....
Product A

1/1/2011 4/1/2011 abc notes $50.00
2/1/2011 4/1/2011 xyz notes $25.00
.
.
.

Product B

2/1/2011 11/1/2011 test notes $55.00 $100.00
.
.
.


I can create an index in another sheet. There are only 10 products.


Thank you..
ray

 

[Ralajer]

That should workout then. I'll take a look at it and post later today.

 

[rayg]

Thank you Rob.

 

[Ralajer]

This should work but may need some tweaking.

Sub CopyProducts()

    Dim lastRow As Long             '// Last row on master sheet that contains a value
    Dim lastCol As Long             '// Last column on master sheet that contains a value
    Dim i As Integer                '// Counter
    Dim numProducts As Integer      '// Total Number of products in List of Products index
    Dim productRows() As Long       '// Row Number contain start of data
    Dim indexRng As Range           '// Range containing the List Product Names
    Dim lookupRng As Range            '// Column containing Product Names on master sheet
    Dim shtNew As Worksheet         '// Variable to help with new sheet creation

    With Worksheets("Master")
        '// Find last cell with a value return row and column
        lastRow = .[A:AZ].Find(what:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lastCol = .[A:AZ].Find(what:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        
        Set lookupRng = .Range(.Cells(1, 1), .Cells(lastRow, 1))
    End With
    
    With Worksheets("Index")
        Set indexRng = .Range(.Range("A2"), .Range("A2").End(xlDown))
    End With
    numProducts = indexRng.Count
    
    ReDim productRows(1 To numProducts + 1)
    
    For i = 1 To numProducts
        productRows(i) = lookupRng.Find(what:=indexRng(i, 1)).Row
    Next i
    
    productRows(numProducts + 1) = lastRow + 1
    
    For i = 1 To numProducts
    
        If WorksheetExists(indexRng(i, 1)) Then
           '// if worksheet exist delete it before creating new
            Application.DisplayAlerts = False
            Sheets(indexRng(i, 1).Value).Delete
            Application.DisplayAlerts = True
        End If
        
        Set shtNew = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        shtNew.Name = indexRng(i, 1)
        Worksheets("Master").Rows(productRows(i) & ":" & productRows(i + 1) - 1).Copy
        shtNew.Paste
        shtNew.Range("A1").Select
    Next i
    
        Worksheets("Master").Activate
        Application.CutCopyMode = False

End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    On Error Resume Next
    WorksheetExists = (Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function

Wasn't sure how to handle product sheets if they already existed decided it was best to delete them and just create a new one. Code requires that product details be on a sheet called "Master" with Product names in Column A and the product name list be on a sheet called "Index" with the product names in Column A starting in Row 2. Either can be adjusted in the code if required. Minimal error checking so if the product in the Index isn't on the master sheet Column A it will fail.

 

[rayg]

Rob, You are WONDERFUL!!
Thanks a ton!
I just need to make small tweaks and it will work perfect for my situation.