VBA - Creating new sheets from dynamic range of names

[Dima064]

Hello, this is my first post.. I've tried to make the query as simple as possible..

I need some help to create a macro with VBA.

Basically..


Number 1

Sheet 1 contains a list in column (A) of different colours. The list has a heading "Sheet Names" and the list is not fixed, it will grow as required. In columns (C) & (D) are "Count" & "Sum" as shown below.

<TABLE style="WIDTH: 239pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=318 border=0><COLGROUP><COL style="WIDTH: 66pt; mso-width-source: userset; mso-width-alt: 3218" width=88><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 77pt; mso-width-source: userset; mso-width-alt: 3730" width=102><TBODY><TR style="HEIGHT: 15pt" height=20><TD class=xl85 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 66pt; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: #d8d8d8" width=88 height=20>Sheet names</TD><TD class=xl82 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 48pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=64></TD><TD class=xl86 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 48pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: #d8d8d8" width=64>Counts</TD><TD class=xl86 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 77pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: #d8d8d8" width=102>Sum (Salary)</TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl84 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>Red</TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl84 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>Green</TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl84 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>Blue</TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD></TR></TBODY></TABLE>
....


I need a macro that will generate a number of new sheets according to the list of colours in column (A). The sheets are required to be named as the colours in the list.


Number2

Sheet 1 also contains a table as below in coumns (F:I) containing "Name, Age, Favourite Colour & Salary". There is a count of entries shown above the "Names" Column and the "Salary" Column has a sum at the top.The table is also not fixed, the entries will grow as required.


<TABLE style="WIDTH: 308pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=408 border=0><COLGROUP><COL style="WIDTH: 77pt; mso-width-source: userset; mso-width-alt: 3730" width=102><COL style="WIDTH: 77pt; mso-width-source: userset; mso-width-alt: 3730" span=3 width=102><TBODY><TR style="HEIGHT: 15pt" height=20><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 77pt; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" width=102 height=20>Count</TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 77pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=102></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 77pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=102></TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 77pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=102>Sum</TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>3</TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD class=xl88 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">$ 2,300.00 </TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl87 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 15pt; BACKGROUND-COLOR: #d8d8d8" colSpan=4 height=20>Table</TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl85 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 15pt; BACKGROUND-COLOR: #d8d8d8" height=20>Name</TD><TD class=xl86 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #d8d8d8">Age</TD><TD class=xl86 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #d8d8d8">Favourite Color</TD><TD class=xl86 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: #d8d8d8">Salary </TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl82 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>Dominic</TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">32</TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">Red</TD><TD class=xl84 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">$ 500.00 </TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl82 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>Joanne</TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">35</TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">Green</TD><TD class=xl84 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">$ 1,000.00 </TD></TR><TR style="HEIGHT: 15pt" height=20><TD class=xl82 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>Ratan</TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">36</TD><TD class=xl83 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">Blue</TD><TD class=xl84 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent">$ 800.00 </TD></TR></TBODY></TABLE>


Following on from Number 1 I need the macro to copy the table to each new sheet including the "count" & "Sum" above the table.

The macro will then be required to delete all the line entries in each table of the new sheets that do not have the same "Favourite Colour" as the sheet name.

Finally, on sheet 1 the macro will be required to display the corresponding "Count" and "Sum" as displayed on each new sheet.


Thank you very much in advance..

Dima..

 

[gsbelbin]

For your first query you need to first create a dynamic range called, say, SheetNames. This can be done by selecting Insert | Name | Define , type SheetNames in the name box and then type =OFFSET(Sheet1!$A$2, 0,0,COUNTA(Sheet1!$A:$A)-1,1) in the Refers To box. This assumes that your list of names is in column A and starts in A2. Then use the following code to create the sheets.

    Dim cell As Range
    For Each cell In Range("SheetNames")
        Sheets.Add
        ActiveSheet.Name = cell.Value
    Next cell

 

[Dima064]

Thank you for the first part, that was really very helpful.

 

[gsbelbin]

Sorry, had to go to a meeting

I've looked at the rest of this and have come up with the following.

the way I've done it you need to create one more dynamic range. I've called it People and the formula, entered as before, is

=OFFSET(Sheet1!$F$5,0,0,COUNTA(Sheet1!$F$5:$F$65536),4)

Then you can use the following VBA to do the rest.

    Dim cell As Range
    Dim lintRow As Integer
 
    For Each cell In Range("SheetNames")
        Sheets.Add
        ActiveSheet.Name = cell.Value
        ActiveSheet.Cells(5, 1).Select
        Worksheets("Sheet2").Range("People").Copy
        ActiveSheet.Paste
 
        lintRow = 6
 
        Do Until Cells(lintRow, 3).Value = ""
            If Cells(lintRow, 3).Value <> ActiveSheet.Name Then
                Range("A" & lintRow & ":D" & lintRow).Select
                Selection.Delete Shift:=xlUp
            Else
                lintRow = lintRow + 1
            End If
        Loop
 
        Cells(1, 1).Value = "Count"
        Cells(1, 4).Value = "Sum"
        Cells(2, 1).Formula = "=COUNTA(A6:A65536)"
        Cells(2, 4).Formula = "=SUM(D6:D65536)"
 
    Next cell

I've tested it for a few different scenarios but you'll need to try all your own different possibilities. Is there any possibility that sheets with the colour names might already exist? This would cause an error and would therefore need to be allowed for.

 

[Dima064]

Hi gsbelbin,

The sheets wouldn't already exist so there isn't any need to allow for the error that would cause.

The code works as far as pasting the table to the correct new sheets. However it doesn't seem to step through each line in the new tables and remove all rows except for those with the same colour as the sheet name.

Any ideas??

I'm using Excel 2007 BTW..******** type=text/javascript> vbmenu_register("postmenu_2399500", true); *********>

 

[gsbelbin]

I tested it on XL2003 and it worked fine. I don't think using 2007 should make a difference so I wonder if I've made an incorrect assumption somewhere. I think you need to step through the code and watch what it is doing on the sheet. Click on the line 'Do Until Cells(lintRow, 3).Value = "" ' and press F9 to insert a breakpoint. Then run the code as normal, it will stop at that line. Then, if you can, position the code window over a bit so that you can also see the workbook. Press F8 to step through each line of the code and you should see the code loop through until it reaches a line where the colour is not the same as the sheet name. It should then select columns A to D on the line and delete it.

Try this and let me know what happens. It will be something trivial that is wrong I'm sure.

 

[Dima064]

That's exactly what I'm doing at the minute

I have tried the code seperately in the different sheets and it works fine removing the entries. Howver it doesn't seem to like doing it when it creates the sheets..... ??

 

[gsbelbin]

Can you describe what it's doing when you step through the Do loop?

 

[Dima064]

It just seems to ignores the code..

 

[gsbelbin]

Does it ignore the first part which adds the sheet and pastes the table or just the Do loop.