With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("CR1"),
Unique:=True

First you say
With ws1
but you don't ever show setting ws1 to anything. There should be a line of
code like

Set ws1 = Activesheet

or

Set ws1 = Worksheets("Data")

However, that should surface as an error on this line
Set rng = ws1.Range("A1", ("A" & NoAccounts)).Product '<<< Change

Remove the [b] from the end of True if it is actually there

You set rng to range reference earlier in the code, so it should be OK
assuming you have data in column A.

so have you defined a named range CR1 (insert=range=Define) and is that
named range located on the sheet which will be referenced by ws1.

--
Regards,
Tom Ogilvy




"Jen" wrote:

I'm trying to create new worksheets based on a column in my active
worksheet. I've copied and altered some code from ron debruin's
webpage. This is part of a much longer module that defined the range
previously. I keep getting caught up in this one area and get an error
that says: "Object variable or With block variable not set" Yes, I'm
clueless and really don't know what I am doing but could use some
help/advice. Thanks.


Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim cell As Range
Dim Lrow As Long

'Tip : Use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A1", ("A" & NoAccounts)).Product '<<< Change

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'THIS IS WHERE THE ERROR IS OCCURING
With ws1
==========================rng.Columns(1).Advanced Filter _
==========================Action:=xlFilterCopy, _
==========================CopyToRange:=.Range("CR 1"),
Unique:=True[b]
'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used to
make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use
the columns)


Lrow = .Cells(Rows.Count, "CR").End(xlUp).row
.Range("CQ1").Value = .Range("CR1").Value

For Each cell In .Range("CR2:CR" & Lrow)
.Range("CQ2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("J1:J2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("J:K").Clear
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With