View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
shabutt shabutt is offline
external usenet poster
 
Posts: 31
Default Error on executing code "ExtractReps"

Hi to everyone,

I successfully run the below code taken from
http://www.contextures.com/excelfile...#Filter(FL0013 - Create New Sheets
from Filtered List) which I have copied in my workbook in separate module.

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("C:C").Copy _
Destination:=Range("L1")
ws1.Columns("L:L").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("J1"), Unique:=True
r = Cells(Rows.Count, "J").End(xlUp).Row

'set up Criteria Area
Range("L1").Value = Range("C1").Value

For Each c In Range("J2:J" & r)
'add the rep name to the criteria area
ws1.Range("L2").Value = c.Value
'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("J:L").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

But an error occurs on executing the macro if the following worksheet change
event codes in Sheet1 are present.

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheets("Summary").PivotTables("SummaryTable"). PivotCache.Refresh
Worksheets("Brief").PivotTables("BriefTable").Pivo tCache.Refresh
If Target.Column = 10 Then
Selection.AutoFilter field:=10, Criteria1:="="
End If
End Sub

How could I resolve the issue and successfully run the ExtractReps macro
even if worksheet change event is present in Sheet1.

Regards.