Help creating temporary worksheets

[Saucer Man]

I am trying to create several temporary worksheets based on column data in
my active sheet. I want to check each row in column R and if a certain
number is in the cell, add that row to a temporary sheet.

I will then be emailing that temporary sheet and deleting the temporary
file. Then I want to search my original active sheet again for a different
number in that cell. I will be doing this about 20 times. I know how to
email these sheets and delete them but I don't know how to create the
temporary sheets.

 

[Gary''s Student]

Sub dural()
Sheets.Add
ActiveSheet.Name = "Even Saucier"
End Sub

 

[Mike H]

Hi,

Try this

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "TempSheet"

Mike

 

[Saucer Man]

Hi.

How's this?

Dim rng As Range
Dim cell As Range
Dim strTempValue As String

Set rng = Intersect(Range("R:R"), ActiveSheet.UsedRange)
For Each cell In rng
strTempValue = (cell.Value)
If strTempValue = "2" Then 'Number to test
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name =
"TempSheet"
End If
Next cell


Will this create a temporary worksheet called "TempSheet" with a copy of the
every entire row it found with "2" in column R?

Will my original sheet still be the Active.Sheet so I can run through this
again later on testing for a different number in column R or does this new
tempsheet become the activesheet?

Thanks.

 

[Saucer Man]

My code this isn't working.

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "TempSheet"

does creates a new worksheet but it doesn't add the row to the sheet. I
would need something like...

Dim rng As Range
Dim cell As Range
Dim strTempValue As String

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "TempSheet"
Set rng = Intersect(Range("R:R"), ActiveSheet.UsedRange)
For Each cell In rng
strTempValue = (cell.Value)
If strTempValue = "2" Then
'Copy entire row to "TempSheet" ......
End If
Next cell
'Call email routine
'Delete this TempSheet

I don't know how to ...
- Copy the row to the tempsheet
- Delete the tempsheet
- keep my original worksheet the ACTIVEsheet so I can use this same code
and run through it again testing for a different number.

Thanks.

 

[Saucer Man]

Anyone?

My code this isn't working.

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "TempSheet"

does creates a new worksheet but it doesn't add the row to the sheet. I
would need something like...

Dim rng As Range
Dim cell As Range
Dim strTempValue As String

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "TempSheet"
Set rng = Intersect(Range("R:R"), ActiveSheet.UsedRange)
For Each cell In rng
strTempValue = (cell.Value)
If strTempValue = "2" Then
'Copy entire row to "TempSheet" ......
End If
Next cell
'Call email routine
'Delete this TempSheet

I don't know how to ...
- Copy the row to the tempsheet
- Delete the tempsheet
- keep my original worksheet the ACTIVEsheet so I can use this same
code and run through it again testing for a different number.

Thanks.

 

[Dave Peterson]

Before you start, take a look at Ron de Bruin's addin:
http://www.rondebruin.nl/easyfilter.htm

Heck, Ron has lots of sample code for emailing workbooks, worksheets, ... on his
site.

But you can keep track of the starting sheet and the new sheet with code like:

Option Explicit
Sub testme()

Dim ActWks As Worksheet
Dim NewWks As Worksheet
Dim Rng As Range
Dim Cell As Range

Set ActWks = ActiveSheet 'or whatever sheet you want
Set NewWks = Worksheets.Add
With NewWks
.Move After:=Worksheets(Worksheets.Count)
.Name = "TempSheet"
End With

With ActWks
Set Rng = Intersect(.Range("R:R"), .UsedRange)
End With

For Each Cell In Rng.Cells
If Cell.Value = 2 Then
'delete any existing tempsheet
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("tempsheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'add one back
Set ActWks = ActiveSheet 'or whatever sheet you want
Set NewWks = Worksheets.Add
With NewWks
.Move After:=Worksheets(Worksheets.Count)
.Name = "TempSheet"
End With

Cell.EntireRow.Copy _
Destination:=NewWks.Range("a1")

'email that sheet or whatever you want to do
End If
Next Cell

End Sub

Untested, but it did compile.

 

[Saucer Man]

Thanks Dave. I actually got my email samples from Ron's page. However,
after reviewing this, I think I am going about this all wrong.

I think it would be best if I create the temporary sheet the first time I
come across a number in activesheet, Column R instead of testing each
number. So I will read every cell in column R (I want to start with the Row
4, not row 1). If the cell contains 001, I want to create a tempsheet
called 001 with the column formatting from my activesheet and the column
names. My active sheet has the column names in Row 3 so I need to copy
these to Row 1 of the temp sheet. I also need to copy the entire row to the
temp sheet just created. The next time I come across 001 in the cell, all I
will need to do is add the entire row to the existing 001 tempsheet. I will
do this for every number I find in Column R. I.E., if I find 117, I will
create a tempsheet called 117 and start to populate it.

Looking at the code you supplied, I came up with this code which works
partially and I found a function to test if the sheet already exists.

Sub Main()

Dim i As Integer
Dim ActWks As Worksheet
Dim TempWks As Worksheet
Dim ActColumn As Range
Dim ActCell As Range
Dim strCell As String

Set ActWks = ActiveSheet
Set ActColumn = Intersect(ActWks.Range("R:R"), ActWks.UsedRange)
For Each ActCell In ActColumn
strCell = Format(ActCell.Value, "000")
If strCell = "" Or strCell = "Region" Then GoTo Continue
If SheetExists(strCell) Then
'just add the entire row to the tempsheet in the next available
row
Else
'create a tempsheet with the column formatting from my
activesheet and the column names and formatting
'from activesheet Row 3
Set TempWks = Worksheets.Add(, ActiveSheet)
TempWks.Name = Format$(strCell, "000")
Set TempWks = Nothing
End If

Continue:
Next ActCell
End Sub

Private Function SheetExists(sname) As Boolean
'Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function


This reads the cells in activesheet column R and creates temporary sheets
with the same name as the number in the cell but it does not...

- copy the formatting from the active sheet to the tempsheet
- copy the column names and formatting from Row 3 of the active sheet to
Row 1 of the tempsheet
- add the entire row of the activesheet to the next available row in the
tempsheet

When this is all done, I will email the sheets that have been created and
then delete them...but finding all the sheets created is a different issue.

Can you assist here? I am using Excel 2007. Thanks.

 

[Dave Peterson]

I think if you look at Ron's site, you'll find code that does most of what you
ask.

Copy|paste should take care of formats (and values and formulas):

Option Explicit
Sub Main()

Dim ActWks As Worksheet
Dim TempWks As Worksheet
Dim ActColumn As Range
Dim ActCell As Range
Dim strCell As String
Dim DestCell As Range

Set ActWks = ActiveSheet

With ActWks
Set ActColumn = Nothing
On Error Resume Next
Set ActColumn = Intersect(.UsedRange, .Range("r4:r" & .Rows.Count))
On Error GoTo 0

If ActColumn Is Nothing Then
MsgBox "nothing column R under row 3!"
Exit Sub
End If
End With

For Each ActCell In ActColumn.Cells
strCell = Format(ActCell.Value, "000")
If strCell = "" _
Or strCell = "Region" Then
'do nothing
Else
If SheetExists(strCell) Then
'just add the entire row
'to the tempsheet in the next available Row
Else
'create a tempsheet with the column formatting from my
'activesheet and the column names and formatting
'from activesheet Row 3
Set TempWks = Worksheets.Add(after:=ActiveSheet)
TempWks.Name = Format$(strCell, "000")
ActWks.Rows(3).Copy _
Destination:=TempWks.Range("a1")
End If
With TempWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
ActCell.EntireRow.Copy _
Destination:=DestCell
End If

Next ActCell
End Sub

Private Function SheetExists(sname) As Boolean
'Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then
SheetExists = True
Else
SheetExists = False
End If
On Error GoTo 0
End Function


This assumes that column A is always used if the the row is used (to determine
the destcell).

You could use a different column if you had to (say R):

With TempWks
Set DestCell = .Cells(.Rows.Count, "R").End(xlUp).Offset(1, 0)
Set DestCell = destcell.entirerow.cells(1)
End With

 

[Saucer Man]

I checked Ron's site but I cannot find answers to the issues I am facing.
Here is what I have now...thanks to your help.

Sub Main()
Dim ActWks As Worksheet
Dim ActRange As Range
Dim ActRegion As Range
Dim DstCell As Range
Dim strRegion As String

Set ActWks = ActiveSheet
With ActWks
Set ActRange = Nothing
On Error Resume Next
Set ActRange = Intersect(.UsedRange, .Range("R4:R" & .Rows.Count))
On Error GoTo 0
End With

For Each ActRegion In ActRange.Cells
strRegion = Format(ActRegion.Value, "000")
If strRegion = "" Then GoTo Continue 'Would like to insert blank row
in all temp sheets
If Not SheetExists(strRegion) Then
'Create temporary sheet.
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Format$(strRegion, "000")
'Copy the column headers to the sheet.
ActWks.Rows(3).Copy
Destination:=Sheets(Sheets.Count).Range("A1")
End If
'Copy the entire row to the correct sheet.
With Sheets(strRegion)
Set DstCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
ActRegion.EntireRow.Copy Destination:=DstCell
Continue:
Next ActRegion
End Sub

- The formatting is still not working. The new sheets are created but the
column widths are all default size. My original sheet that I am working
from has custom widths and column formatting that is not being copied to the
new sheets.

- The way it is now, if I encounter a blank line, I am not copying anything.
I have "If strRegion = "" Then GoTo Continue". I would like to actually
create a blank row in every temp sheet that exists at the time this line is
executed. Then the next time it copys a row to the sheets, there will be a
blank row before it. Is this possible?

- When this is completed, how do I delete all these tempsheets that were
created without deleting the production sheets? The names of the tempsheets
will change daily based on the value of column R.

Thanks again for any assistance.

 

[Dave Peterson]

Depending on the version of excel, you can copy|paste special|columnwidths.

You'll use some code like:

Worksheets("Sheet1").Columns.Copy
Worksheets("sheet2").Range("a1").PasteSpecial Paste:=xlPasteColumnWidths

or in xl2k:

Worksheets("Sheet1").Columns.Copy
Worksheets("sheet2").Range("a1").PasteSpecial Paste:=8

In the code I suggested:

If SheetExists(strCell) Then
'just add the entire row
'to the tempsheet in the next available Row
Else
'create a tempsheet with the column formatting from my
'activesheet and the column names and formatting
'from activesheet Row 3
Set TempWks = Worksheets.Add(after:=ActiveSheet)
TempWks.Name = Format$(strCell, "000")
ActWks.Rows(3).Copy _
Destination:=TempWks.Range("a1")
actwks.columns.copy
tempwks.range("a1").pastespecial
paste:=xlPasteColumnWidths
End If

===========

As for the other stuff, I think you'll need a rewrite of your code. Maybe you
can create a list of all the sheetnames that will be created so that you can add
the extra blank row whenever you need to.

But even then, I would think you'd want to use some unique string to use as a
filler (like $$$$$$$ in column A). Then add all your data normally and then
cycle through all the sheets doing an Edit|replace to get rid of those $$$$$$$
in column A.

And if I wanted to delete those sheets later, I wouldn't add them to my
workbook. I'd create a new workbook and then add them there. Then I could
close that workbook without saving when I wanted to get rid of them.

Dim NewWkbk as workbook
set newwkbk = workbooks.add(1) 'single sheet
newwkbk.worksheets(1).name = "deletemelater"
....

Set TempWks _
= newwkbk.Worksheets.Add(after:=newwkbk.worksheets(newwkbk.worksheets.count)

 

[Dave Peterson]

ps.

If you're going to add those features to your program, you may want to look
again at Ron de Bruin's site or at Debra Dalgleish's site.

Ron de Bruin's EasyFilter addin:
http://www.rondebruin.nl/easyfilter.htm

Or:

Code from Debra Dalgleish's site:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list; macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

Update Sheets from Master -- uses an Advanced Filter to send data from
Master sheet to individual worksheets -- replaces old data with current.
AdvFilterCity.xls 55 kb

==========
Maybe you could create an advanced filter (or autofilter) that filters on both
the value you want and empty cells.

 

[Saucer Man]

That advfilterrepfiltered does almost exactly what I am looking for. The
code I have been working on is almost done and now includes the column
header widths and freezing the top row.

I was actually thinking about creating a new workbook for these sheets and
then just closing the book However, my experiments showed that none of my
conditional formatting was present in the new book. I have conditional
formating to give me the green bar look and to apply a border to the cells.
When I saw that none of this was present in the new book, I gave up on this
idea and continued working in the same workbook.

Since the Regions column will be a number between 1 and whatever, I will
just name my temporary sheets with these numbers. Then I can do a loop from
1 to whatever and use the SheetExists function. If the sheet exists, I can
email it and then delete it. In theory this seems to be ok so I will start
to code and test it.

In reference to the email, currently I am using this method of Ron's to send
a page in the body of an email.

http://www.rondebruin.nl/mail/folder3/mail2.htm

The only thing about this I don't like is the top row that is frozen in
excel is not frozen in the email body. Do you know if one of the other
email methods Ron has actually keeps the row frozen in the email?

Thanks again.

ps.

If you're going to add those features to your program, you may want to
look
again at Ron de Bruin's site or at Debra Dalgleish's site.

Ron de Bruin's EasyFilter addin:
http://www.rondebruin.nl/easyfilter.htm

Or:

Code from Debra Dalgleish's site:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list;
macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

Update Sheets from Master -- uses an Advanced Filter to send data from
Master sheet to individual worksheets -- replaces old data with current.
AdvFilterCity.xls 55 kb

==========
Maybe you could create an advanced filter (or autofilter) that filters on
both
the value you want and empty cells.

 

[Dave Peterson]

I don't know if Ron goes to that much trouble--a different sample for each
variation.

But why not just freeze the panes like you want.

This is one of the few times that you actually have to activate that sheet.

Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
.Select
.Range("a1").Select 'make sure it's visible
.Range("a2").Select 'location of the freeze panes
ActiveWindow.FreezePanes = False 'remove existing
ActiveWindow.FreezePanes = True
End With
Next wks

You can check the worksheet names when you're looping through them.

That advfilterrepfiltered does almost exactly what I am looking for. The
code I have been working on is almost done and now includes the column
header widths and freezing the top row.

I was actually thinking about creating a new workbook for these sheets and
then just closing the book However, my experiments showed that none of my
conditional formatting was present in the new book. I have conditional
formating to give me the green bar look and to apply a border to the cells.
When I saw that none of this was present in the new book, I gave up on this
idea and continued working in the same workbook.

Since the Regions column will be a number between 1 and whatever, I will
just name my temporary sheets with these numbers. Then I can do a loop from
1 to whatever and use the SheetExists function. If the sheet exists, I can
email it and then delete it. In theory this seems to be ok so I will start
to code and test it.

In reference to the email, currently I am using this method of Ron's to send
a page in the body of an email.

http://www.rondebruin.nl/mail/folder3/mail2.htm

The only thing about this I don't like is the top row that is frozen in
excel is not frozen in the email body. Do you know if one of the other
email methods Ron has actually keeps the row frozen in the email?

Thanks again.

 

[Saucer Man]

Thanks for all the help Dave. I am almost done and with any luck I won't
run into anymore roadblocks!

I don't know if Ron goes to that much trouble--a different sample for each
variation.

But why not just freeze the panes like you want.

This is one of the few times that you actually have to activate that
sheet.

Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
.Select
.Range("a1").Select 'make sure it's visible
.Range("a2").Select 'location of the freeze panes
ActiveWindow.FreezePanes = False 'remove existing
ActiveWindow.FreezePanes = True
End With
Next wks

You can check the worksheet names when you're looping through them.