asked on

Create Worksheet name based on cell value and copy over cells to new sheet.

Hi Guys,

I'd like to create a Worksheet (several worksheets) and name them based on a cell value (B2 - down to the last row) and then copy the all data on that row pertaining to that cell.

I have found the following code on the Internet and it does exactly what i want with one exception.
It references the data found in Column A and i would like it to use Column B as the point of reference.

Here's the code.

Sub CreateNewWorksheets()

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("A1", Range("A65536").End(xlUp))

'Delete any Worksheet called "UniqueList"
'Turn off run time errors & delete alert

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete

'Add a Worksheet called "UniqueList"
Worksheets.Add().Name = "UniqueList"

'Filter the Set range so only a unique list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
 Worksheets("UniqueList").Range("A1"), True

 'Set a range variable to the unique list, less the heading.
 Set rRange = .Range("A2", .Range("A65536").End(xlUp))
End With

On Error Resume Next
With wSheetStart
For Each rCell In rRange
  strText = rCell
 .Range("A1").AutoFilter 1, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'Copy the visible filtered range _
(default of Copy Method) and leave hidden rows
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
Next rCell
End With

With wSheetStart
.AutoFilterMode = False
.Activate
End With
End Sub

Open in new window

I have changed all manner of ranges on the above code and as much as i can get it to filter on the B Column and create the Unique list, it doesn't copy all the data over like it would if the code was "as is"

Can anybody help me get this working..?
To re-iterate, i would like the code to reference Column B for it's Unique List and then create the Worksheet and copy all data as it would normally...

Many thanks in advance.
Darren

Eric Zwiekhorst

Try this, if your data should not be in column A in the new worksheet please change the last reference to A1 also to B1.

Sub CreateNewWorksheets()

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("B1", Range("B65536").End(xlUp))

'Delete any Worksheet called "UniqueList"
'Turn off run time errors & delete alert

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete

'Add a Worksheet called "UniqueList"
Worksheets.Add().Name = "UniqueList"

'Filter the Set range so only a unique list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True

'Set a range variable to the unique list, less the heading.
Set rRange = .Range("B2", .Range("B65536").End(xlUp))
End With

On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("B1").AutoFilter 1, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'Copy the visible filtered range _
(default of Copy Method) and leave hidden rows
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
Next rCell
End With

With wSheetStart
.AutoFilterMode = False
.Activate
End With
End Sub

vestanpance_uk

ASKER

Hi Zwiekhorst,

Thanks for looking, sadly though it doesn't work.....

Here is a small piece of my Worksheet and possibly a more detailed explanation....

The Worksheet looks this at the moment, spread over 4 Columns. (switch names changed for security)

Count      Host        Error Type        Message
8        switch1      %LINK-4-ERROR        FastEthernet0/13 is experiencing errors
3        switch2      %LINK-4-ERROR        FastEthernet0/10 is experiencing errors
2        switch3      %LINK-4-ERROR        FastEthernet0/6 is experiencing errors
1        switch4      %RTD-1-LINK_FLAP        FastEthernet0/4 link down/up 5 times per min
1        switch5      %SNMP-5-COLDSTART        SNMP agent on host switch5 is undergoing a cold start
1        switch6      %SYS-2-PS_FAIL        Power supply 3 failed
1        switch7      %SYS-3-PORT_RX_BADCODE      Port 7/9 detected 845 bad code errors in last 30 minutes
1        switch8      %SYS-5-RESTART      System restarted --

As the stands at the moment, without being altered, it looks at Column A (Count) creates 4 Worksheets with names based on each cell value within Column A, ( so worksheets are called 8, 3, 2, 1 ) and then it copies data from the main sheet to the seperate sheets.

So, from the main sheet (where the data lies) it copies the row with Count 8 and pastes it to the Worksheet called 8.
Then copies Row (Count 2) and pastes it to WorkSheet 2 and so on and so forth.

If i were to delete Column A (Count) so that the switch hosts were in Column A this would work perfectly (as i want) but unfortunately i must keep the Count in there as well and preferably in Column A.
The code you supplied, (as much as your assistance is appreciated) does exactly the same thing as i managed to get it to do. - Create a Unique List on the data in Column B (great!) but then NOT create the Worksheets based on the switch names and DOESNT copy the data over to the Worksheets (because they don't exist)

Cheers
Daz

ASKER CERTIFIED SOLUTION

Eric Zwiekhorst

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

vestanpance_uk

ASKER

Thanks Zwiekhorst,

That's exactly what i wanted...

I looked through the code and with exception of the cell references changing, i noted that one line had changed to AutoFilter 2,

" .Range("B1").AutoFilter 2, strText"

What is that line doing now, that AutoFilter 1, wasn't doing? (just for my own understanding)

Points on the way!

Thanks again!!
Daz

Eric Zwiekhorst

Hi Daz,

Indeed the 1 is refering to the column number, 2 is column B

Kind regards

Eric

vestanpance_uk

ASKER

Thanks very much for your time Eric and for explaining the code...

Cheers
Daz