I have one worksheet with multiple columns. In one of these columns (C
I have a number of currencies. However, both the number of rows an
number of currencies can change from day to day. I would like to b
able to create additional worksheets for each of the relevan
currencies and cut the data from workseet 1 into each of the individua
currency sheets?

For example:

Column B has 4 rows.

Row 1 has value of USD
Row 2 has value of EUR
Row 3 has value of EUR
Row 4 has value of FRF
etc.....

After running the procedure I should now have three workseets, one fo
USD with one row, one for EUR with two rows and one for FRF with on
row.

Any pointers in the right direction would be appreciated.

Regards,

Adria

--
Message posted from http://www.ExcelForum.com

Hi Adrian,

Here is a shot


Sub MyCurrencies()
Dim cNumRows As Long
Dim i As Long
Dim cNextRow As Long
Dim sh As Worksheet

With ActiveSheet
cNumRows = .Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To cNumRows
If Not SheetExists(.Cells(i, "C").Value) Then
Worksheets.Add.Name = .Cells(i, "C").Value
Worksheets(.Cells(i, "C").Value).Cells(1, "A").Value =
..Cells(i, "C").Value
Else
Set sh = Worksheets(.Cells(i, "C").Value)
cNextRow = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
sh.Cells(cNextRow, "A").Value = .Cells(i, "C").Value
End If
Next i
End With

End Sub

'-----------------------------------------------------------------
Function SheetExists(sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(sh) Is Nothing)
On Error GoTo 0
End Function



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Kobayashi " wrote in message
...
I have one worksheet with multiple columns. In one of these columns (C)
I have a number of currencies. However, both the number of rows and
number of currencies can change from day to day. I would like to be
able to create additional worksheets for each of the relevant
currencies and cut the data from workseet 1 into each of the individual
currency sheets?

For example:

Column B has 4 rows.

Row 1 has value of USD
Row 2 has value of EUR
Row 3 has value of EUR
Row 4 has value of FRF
etc.....

After running the procedure I should now have three workseets, one for
USD with one row, one for EUR with two rows and one for FRF with one
row.

Any pointers in the right direction would be appreciated.

Regards,

Adrian


---
Message posted from http://www.ExcelForum.com/

Bob, this is fantastic! As always, many thanks indeed! I've lost coun
of the number of times either yourself or Tom (Oglivy) have helped m
enormously!

However, one very minor point. I want to copy the entirerow and no
just the currency value into the new worksheets? I'm trying to adap
your code now to accomodate but if you are online and can help the
that would also be appreciated!

Many thanks indeed!

Adria

--
Message posted from http://www.ExcelForum.com

Adrian ,

This changed version of MyCurrencies procedure does it (I hope!)

Sub MyCurrencies()
Dim cNumRows As Long
Dim i As Long
Dim cNextRow As Long
Dim sh As Worksheet

With ActiveSheet
cNumRows = .Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To cNumRows
If Not SheetExists(.Cells(i, "C").Value) Then
Worksheets.Add.Name = .Cells(i, "C").Value
.Cells(i, "C").EntireRow.Copy Worksheets(.Cells(i,
"C").Value).Cells(1, "A")
Else
Set sh = Worksheets(.Cells(i, "C").Value)
cNextRow = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(i, "C").EntireRow.Copy sh.Cells(cNextRow, "A")
End If
Next i
End With

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Kobayashi " wrote in message
...
Bob, this is fantastic! As always, many thanks indeed! I've lost count
of the number of times either yourself or Tom (Oglivy) have helped me
enormously!

However, one very minor point. I want to copy the entirerow and not
just the currency value into the new worksheets? I'm trying to adapt
your code now to accomodate but if you are online and can help then
that would also be appreciated!

Many thanks indeed!

Adrian


---
Message posted from http://www.ExcelForum.com/

Bob,

Again, many thanks for the very speedy response! In the interim I'v
actually surprised myself and amended the code which seems to work
Basically, I just replaces some of the 'cells' references to that o
'rows'. However, I'd be interested in your opinion and if you recomen
me replacing it with what you have just recently submitted then
certainly shall?

I've also changed the With reference to a variable I'm already declare
in my module.

Dim cNumRows As Long
Dim i As Long
Dim cNextRow As Long
Dim sh As Worksheet

With Newsheet
cNumRows = .Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To cNumRows
If Not SheetExists(.Cells(i, "C").Value) Then
Worksheets.Add.Name = .Cells(i, "C").Value
Worksheets(.Cells(i, "C").Value).Rows(1).Value = _
.Cells(i, "C").EntireRow.Value
Else
Set sh = Worksheets(.Cells(i, "C").Value)
cNextRow = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
sh.Rows(cNextRow).Value = .Cells(i, "C").EntireRow.Value
End If
Next i
End With

End Sub

Many thanks,

Adria

--
Message posted from http://www.ExcelForum.com

Adrian,

This doesn't seem to work for me. It creates all of the sheets but nothing
is copied across. The statements

..Cells(i, "C").EntireRow.Value

seems to return a blank, because it is trying to get the value of a whole
row.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Kobayashi " wrote in message
...
Bob,

Again, many thanks for the very speedy response! In the interim I've
actually surprised myself and amended the code which seems to work!
Basically, I just replaces some of the 'cells' references to that of
'rows'. However, I'd be interested in your opinion and if you recomend
me replacing it with what you have just recently submitted then I
certainly shall?

I've also changed the With reference to a variable I'm already declared
in my module.

Dim cNumRows As Long
Dim i As Long
Dim cNextRow As Long
Dim sh As Worksheet

With Newsheet
cNumRows = .Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To cNumRows
If Not SheetExists(.Cells(i, "C").Value) Then
Worksheets.Add.Name = .Cells(i, "C").Value
Worksheets(.Cells(i, "C").Value).Rows(1).Value = _
Cells(i, "C").EntireRow.Value
Else
Set sh = Worksheets(.Cells(i, "C").Value)
cNextRow = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
sh.Rows(cNextRow).Value = .Cells(i, "C").EntireRow.Value
End If
Next i
End With

End Sub

Many thanks,

Adrian


---
Message posted from http://www.ExcelForum.com/

Bob,

Strange? I couldn't get the ..cells reference working on your firs
submission so changed it to worksheets.cells......., which seemed t
work? Never mind, it is working which is the main thing and I've save
your amendments also just in case it goes wonky on me!

Thanks again,

Adria

--
Message posted from http://www.ExcelForum.com

Right, as you say, if it works!

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Kobayashi " wrote in message
...
Bob,

Strange? I couldn't get the ..cells reference working on your first
submission so changed it to worksheets.cells......., which seemed to
work? Never mind, it is working which is the main thing and I've saved
your amendments also just in case it goes wonky on me!

Thanks again,

Adrian


---
Message posted from http://www.ExcelForum.com/