I’m 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
it’s 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" <(E-Mail Removed)> wrote in message news:386C0AAB-69EE-41CC-899B-(E-Mail Removed)...
> I’m 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
> it’s 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" <(E-Mail Removed)> wrote in message news:386C0AAB-69EE-41CC-899B-(E-Mail Removed)...
> > I’m 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
> > it’s 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:

> I’m 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
> it’s 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:
>
> > I’m 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
> > it’s 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''.