Im trying to figure out a way to loop through a list (now the range is
A1:E10, but it will change) and copy/paste each unique set of numbers into
its own sheet. For instance, I want to put all 1s in ColumnA on Sheet named
€˜1, all 2s in ColumnA on sheet named €˜2, etc. I have numbers 1-7 in my
range now (so I want to dynamically create 7 sheets), but this will change.

This is the code I am working with now:
Sub CopyNums()
Dim c As Range
Dim d As Range
Dim FirstAddress As String
Dim myFindString As String
Dim NewSht As Worksheet

myFindString = "1"
With ActiveSheet.Range("A:E")
Set c = .Find(myFindString, LookIn:=xlValues, LookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
FirstAddress = c.Address
End If

Selection.Copy

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < FirstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If

'Add a worksheet
'Set NewSht = ActiveWorkbook.Worksheets.Add
'NewSht.Name = myFindString

Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select


End With
d.Select
End Sub

That takes all the 1s and put them in G1 (of the same sheet, but this is not
what I want to do). So, it doesn't let me do what I want to do, and in fact,
it only works sometimes. Ugh! I guess the Union operator is getting screwed
up. Any suggestions as to how I can make this work?

Thanks,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.

Try this example

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



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm



"ryguy7272" wrote in message ...
Im trying to figure out a way to loop through a list (now the range is
A1:E10, but it will change) and copy/paste each unique set of numbers into
its own sheet. For instance, I want to put all 1s in ColumnA on Sheet named
€˜1, all 2s in ColumnA on sheet named €˜2, etc. I have numbers 1-7 in my
range now (so I want to dynamically create 7 sheets), but this will change.

This is the code I am working with now:
Sub CopyNums()
Dim c As Range
Dim d As Range
Dim FirstAddress As String
Dim myFindString As String
Dim NewSht As Worksheet

myFindString = "1"
With ActiveSheet.Range("A:E")
Set c = .Find(myFindString, LookIn:=xlValues, LookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
FirstAddress = c.Address
End If

Selection.Copy

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < FirstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If

'Add a worksheet
'Set NewSht = ActiveWorkbook.Worksheets.Add
'NewSht.Name = myFindString

Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select


End With
d.Select
End Sub

That takes all the 1s and put them in G1 (of the same sheet, but this is not
what I want to do). So, it doesn't let me do what I want to do, and in fact,
it only works sometimes. Ugh! I guess the Union operator is getting screwed
up. Any suggestions as to how I can make this work?

Thanks,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.

Thanks Ron! Very clever! I've used your code many times in the past.
Thanks so much! This time the data is organized differently; the code you
suggested won't work for me in this instance. Here's a sample of my data:

1 2 1 1 2
2 3 2 2 1
1 2 1 1 2
3 4 3 3 4
1 2 1 1 2
4 5 4 4 5

So, I'd like a sheet named 1, with the value 1 in A1:A10. Then, I'd like a
sheet named 2, with the value 2 in A1:A8. Then, I'd like a sheet named 3,
with the value 3 in A1:A4. Does it make sense? I'm going to keep working on
it, but I don't think I'm very close to a solution.

Thanks!
Ryan--



--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Ron de Bruin" wrote:

Try this example

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



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm



"ryguy7272" wrote in message ...
Im trying to figure out a way to loop through a list (now the range is
A1:E10, but it will change) and copy/paste each unique set of numbers into
its own sheet. For instance, I want to put all 1s in ColumnA on Sheet named
€˜1, all 2s in ColumnA on sheet named €˜2, etc. I have numbers 1-7 in my
range now (so I want to dynamically create 7 sheets), but this will change.

This is the code I am working with now:
Sub CopyNums()
Dim c As Range
Dim d As Range
Dim FirstAddress As String
Dim myFindString As String
Dim NewSht As Worksheet

myFindString = "1"
With ActiveSheet.Range("A:E")
Set c = .Find(myFindString, LookIn:=xlValues, LookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
FirstAddress = c.Address
End If

Selection.Copy

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < FirstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If

'Add a worksheet
'Set NewSht = ActiveWorkbook.Worksheets.Add
'NewSht.Name = myFindString

Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select


End With
d.Select
End Sub

That takes all the 1s and put them in G1 (of the same sheet, but this is not
what I want to do). So, it doesn't let me do what I want to do, and in fact,
it only works sometimes. Ugh! I guess the Union operator is getting screwed
up. Any suggestions as to how I can make this work?

Thanks,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.

.

Why not just count them

Sub sonic()
Set sht = Sheets("Sheet1")
Dim x As Long
Dim NumNum As Long
For x = 1 To WorksheetFunction.Max(sht.Range("A1:E10"))
NumNum = WorksheetFunction.CountIf(sht.Range("A1:E10"), x)
If NumNum 0 Then
Worksheets.Add().Name = CStr(x)
Range("A1:A" & NumNum) = x
NumNum = 0
End If
Next
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"ryguy7272" wrote:

Im trying to figure out a way to loop through a list (now the range is
A1:E10, but it will change) and copy/paste each unique set of numbers into
its own sheet. For instance, I want to put all 1s in ColumnA on Sheet named
€˜1, all 2s in ColumnA on sheet named €˜2, etc. I have numbers 1-7 in my
range now (so I want to dynamically create 7 sheets), but this will change.

This is the code I am working with now:
Sub CopyNums()
Dim c As Range
Dim d As Range
Dim FirstAddress As String
Dim myFindString As String
Dim NewSht As Worksheet

myFindString = "1"
With ActiveSheet.Range("A:E")
Set c = .Find(myFindString, LookIn:=xlValues, LookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
FirstAddress = c.Address
End If

Selection.Copy

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < FirstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If

'Add a worksheet
'Set NewSht = ActiveWorkbook.Worksheets.Add
'NewSht.Name = myFindString

Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select


End With
d.Select
End Sub

That takes all the 1s and put them in G1 (of the same sheet, but this is not
what I want to do). So, it doesn't let me do what I want to do, and in fact,
it only works sometimes. Ugh! I guess the Union operator is getting screwed
up. Any suggestions as to how I can make this work?

Thanks,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.

Brilliant!!!!! Thanks Mike!!
Ryan--

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Mike H" wrote:

Why not just count them

Sub sonic()
Set sht = Sheets("Sheet1")
Dim x As Long
Dim NumNum As Long
For x = 1 To WorksheetFunction.Max(sht.Range("A1:E10"))
NumNum = WorksheetFunction.CountIf(sht.Range("A1:E10"), x)
If NumNum 0 Then
Worksheets.Add().Name = CStr(x)
Range("A1:A" & NumNum) = x
NumNum = 0
End If
Next
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"ryguy7272" wrote:

Im trying to figure out a way to loop through a list (now the range is
A1:E10, but it will change) and copy/paste each unique set of numbers into
its own sheet. For instance, I want to put all 1s in ColumnA on Sheet named
€˜1, all 2s in ColumnA on sheet named €˜2, etc. I have numbers 1-7 in my
range now (so I want to dynamically create 7 sheets), but this will change.

This is the code I am working with now:
Sub CopyNums()
Dim c As Range
Dim d As Range
Dim FirstAddress As String
Dim myFindString As String
Dim NewSht As Worksheet

myFindString = "1"
With ActiveSheet.Range("A:E")
Set c = .Find(myFindString, LookIn:=xlValues, LookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
FirstAddress = c.Address
End If

Selection.Copy

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < FirstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If

'Add a worksheet
'Set NewSht = ActiveWorkbook.Worksheets.Add
'NewSht.Name = myFindString

Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select


End With
d.Select
End Sub

That takes all the 1s and put them in G1 (of the same sheet, but this is not
what I want to do). So, it doesn't let me do what I want to do, and in fact,
it only works sometimes. Ugh! I guess the Union operator is getting screwed
up. Any suggestions as to how I can make this work?

Thanks,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.