Question

I am working on a simple subroutine to pull values from the Primary Worksheet and to move those values to the additional sheets. When I run the VBA macro it never gets past the subroutine declaration, any suggestions would greatly be appreciated.

Option Explicit
Sub Macro2()
Dim rCell As Range, ws As Worksheet
Application.DisplayAlerts = False

With Sheets("Sheet1")
Sheets.Add().Name = "Temp"
.Range("D2", .Range("D" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy,         CopyToRange:=Sheets("Temp").Range("B1"), Unique:=True
For Each rCell In Sheets("Temp").Range("D2", Sheets("Temp").Range("B" & Rows.Count).End(xlUp))
    If Not IsEmpty(rCell) Then
        .Range("D2").AutoFilter field:=3, Criteria1:=rCell
        If SheetExists(rCell.Text) Then
            Set ws = Sheets(rCell.Text)
        Else
            Set ws = Worksheet.Add(After:=Worksheets(Worksheets.Count - 1))
            ws.Name = rCell
        End If
        With .AutoFilter.Range
            .Offset(1).Resize(.Rows.Count - 1).Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
        End With
    End If
Next rCell
Sheets("Temp").Delete
.AutoFilterMode = False
End With

Application.DisplayAlerts = True

End Sub

added Function

 Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
 Dim sht As Worksheet

 If wb Is Nothing Then Set wb = ThisWorkbook
 On Error Resume Next
 Set sht = wb.Sheets(shtName)
 On Error GoTo 0
 SheetExists = Not sht Is Nothing
 End Function

New error

extract range has a illegal or missing field name

@

.Range("D2", .Range("D"&Rows.Count).End(xlDown)).AdvancedFilter  Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("B1"), Unique:=True

Answer 1

When I run that code, it says:

Compile Error:

Sub or Function not defined

and then highlights the SheetExists function. Either SheetExist is a function you forgot to include in your form, or it’s a custom function that wasn’t included in your example.

EDIT: Wow, there’s a lot going on here.

If you step through the code after that, you’ll also get a Run-time 1004 error (“Application-defined or object-defined error”) here:

.Range("D2", .Range("D" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("B1"), Unique:=True

Try changing that to:

.Range("D2", .Range("D" & Rows.Count).End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("B1"), Unique:=True

From there, change this:

Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count - 1))
ws.Name = rCell

to this:

Worksheets.Add(After:=Worksheets(Worksheets.Count - 1)).Name = rCell

From there, though, I’m not sure what With .AutoFilter.Range is supposed to be doing, unless you meant With Sheets("Sheet1").AutoFilter.Range.

From a debugging standpoint, you really want to add On Error Goto ErrRoutine at the beginning of your code, then add this to the end of your routine:

    Exit Sub

ErrRoutine:

    MsgBox Err.Description
    Resume

And put a breakpoint on MsgBox Err.Description to step back to the offending line.