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.
"Dave Peterson" wrote in message
...
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 wrote:
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(n ewwkbk.worksheets.count)
Saucer Man wrote:
<<snipped
- 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" wrote in message
...
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
--
Dave Peterson
--
Dave Peterson