Hi all,

I'm still having trouble with this one.

I've a list of names in A14 to around A130. I can make a Unquie List
with the below code around 29 unique items.

I now need to check each cell from A14 down. If A14 to A19 are say item
1 in Array e.g John I need it to

Add a new sheet.
Copy A14:AW19
Paste all then paste Special Values

Then loop through the next name in array and do the same. Any help
appreciated as ever




Code:
--------------------

Sub UniqueList()


Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
Set rRange = Range("A13", Range("A65536").End(xlUp))

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

Worksheets.Add().Name = "UniqueList"

With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A13"), True


Set rRange = .Range("A14", .Range("A65536").End(xlUp))
End With


arr = rRange
'Loop


End Sub


--------------------



VBA Noob


--
VBA Noob
------------------------------------------------------------------------
VBA Noob's Profile: http://www.excelforum.com/member.php...o&userid=33833
View this thread: http://www.excelforum.com/showthread...hreadid=571493

Have you try my example in your other thread ?

--
Regards Ron de Bruin
http://www.rondebruin.nl



"VBA Noob" wrote in message
...

Hi all,

I'm still having trouble with this one.

I've a list of names in A14 to around A130. I can make a Unquie List
with the below code around 29 unique items.

I now need to check each cell from A14 down. If A14 to A19 are say item
1 in Array e.g John I need it to

Add a new sheet.
Copy A14:AW19
Paste all then paste Special Values

Then loop through the next name in array and do the same. Any help
appreciated as ever




Code:
--------------------

Sub UniqueList()


Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
Set rRange = Range("A13", Range("A65536").End(xlUp))

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

Worksheets.Add().Name = "UniqueList"

With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A13"), True


Set rRange = .Range("A14", .Range("A65536").End(xlUp))
End With


arr = rRange
'Loop


End Sub


--------------------



VBA Noob


--
VBA Noob
------------------------------------------------------------------------
VBA Noob's Profile: http://www.excelforum.com/member.php...o&userid=33833
View this thread: http://www.excelforum.com/showthread...hreadid=571493

Hi Ron,

I was having trouble with it hence the repost with a different angle.

Change the following

Set ws1 = Sheets("Control")
Set rng = ws1.Range("A13").CurrentRegion
CopyToRange:=WSNew.Range("A2"), _
Unique:=False


It added the sheets correctly but

It's entering the headers again in Template from Row 2. So Row 1 and
has T to AW headers
It's pasting values into T2 to AW2 down instead of formulas

Not sure why. Any thoughts



VBA Noo

--
VBA Noo
-----------------------------------------------------------------------
VBA Noob's Profile: http://www.excelforum.com/member.php...fo&userid=3383
View this thread: http://www.excelforum.com/showthread.php?threadid=57149

Look at Ron de Bruin's approach:

http://www.rondebruin.nl/copy5.htm

--
Regards,
Tom Ogilvy

"VBA Noob" wrote:


Hi all,

I'm still having trouble with this one.

I've a list of names in A14 to around A130. I can make a Unquie List
with the below code around 29 unique items.

I now need to check each cell from A14 down. If A14 to A19 are say item
1 in Array e.g John I need it to

Add a new sheet.
Copy A14:AW19
Paste all then paste Special Values

Then loop through the next name in array and do the same. Any help
appreciated as ever




Code:
--------------------

Sub UniqueList()


Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
Set rRange = Range("A13", Range("A65536").End(xlUp))

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

Worksheets.Add().Name = "UniqueList"

With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A13"), True


Set rRange = .Range("A14", .Range("A65536").End(xlUp))
End With


arr = rRange
'Loop


End Sub


--------------------



VBA Noob


--
VBA Noob
------------------------------------------------------------------------
VBA Noob's Profile: http://www.excelforum.com/member.php...o&userid=33833
View this thread: http://www.excelforum.com/showthread...hreadid=571493