Problemer med sletning af cellenavne

Denne burde slette alle nanve i din mappe:

Sub SletNavne()
    For Each n In ActiveWorkbook.Names
        n.Delete
    Next n
End Sub

Nu er problemet at jeg kun skal have slettet de navne som er indenfor det slettede område. Derfor havde jeg i min kode prøvet at springe til hver navneområde, og hvis der var fejl på den handling, slette det pågældende område.

Denne kode ser ud til at klare jobbet:

Sub DeleteBrokenNames()
    Dim Nme As Name

    For Each Nme In ActiveWorkbook.Names
        If Right(Nme.RefersTo, 5) = "#REF!" And Left(Nme.RefersTo, 12)"=Projektdata" Then
            Nme.Delete
        End If
    Next Nme

End Sub

Eller endnu bedre. Tager højde for at cellerne ikke nødvendigvis hænger sammen.

http://www.microsoft.com/office/community/da-dk/default.mspx?query=akyhne&dg=&cat=en-us-office&lang=en&cr=US&pt=3a4e9862-cdce-4bdc-8664-91038e3eb1e9&catlist=&dglist=&ptlist=&exp=&sloc=da-dk

Sub DelNames()
Dim n As Long
Dim nm As Name
Dim vArr()
n = 1
For Each nm In ActiveWorkbook.Names
    If InStr(nm.RefersTo, "#REF!") Then
        n = n + 1
        ReDim Preserve vArr(1 To n)
        vArr(n) = nm.Name
        nm.Delete
    End If
Next
If n > 1 Then
    vArr(1) = "Names deleted"
    ActiveWorkbook.Worksheets.Add
    Range("A1").Resize(n, 1).Value = Application.Transpose(vArr)
    MsgBox "Find & rectify these names if used in formulas"
Else
    MsgBox "No names deleted"
End If

End Sub

Sub Test()
With ActiveWorkbook
    For i = 1 To 4
        .Names.Add "myNameACE_" & i, Union([a1], [c1], [e1])
        .Names.Add "myNameAE_" & i, Union([a1], [e1])
        .Names.Add "myNameAC_" & i, Union([a1], [c1])
    Next
    Columns("C:C").Delete
End With

' DelNames
End Sub