Sub FindeExternalConstraints()
Dim rngOne As Range
Dim rngAll As Range
Dim blnEmpty As Boolean
Dim strFormula As String


Set rngAll = Application.Intersect(Selection, ActiveSheet.UsedRange)

If rngAll Is Nothing Then
    MsgBox "Range does not intersect with UsedRange"
Else
    rngAll.Select
End If

blnEmpty = True

On Error Resume Next

For Each rngOne In rngAll
    strFormula = rngOne.Formula

    If InStr( 1 , strFormula, "[") <>  0  Then
        rngOne.Interior.ColorIndex =  4 
        blnEmpty = False
    End If
    
Next rngOne

If blnEmpty Then
MsgBox "No constraints!"
End If
End Sub

Sub EmptyORNnot()
Dim rngOne As Range
Dim rngAll As Range
Dim blnEmpty As Boolean
Dim strName As String


Set rngAll = Application.Intersect(Selection, ActiveSheet.UsedRange)

If rngAll Is Nothing Then
    MsgBox "Ranges do not intersect"
Else
    rngAll.Select
End If

blnEmpty = True


On Error Resume Next

For Each rngOne In rngAll
'============================
    If rngOne.Formula <> "" Then
        MsgBox "Íå ïóñòî!"
        rngOne.Interior.ColorIndex =  4 
        blnEmpty = False
    End If
'============================
    strName = ""
    strName = rngOne.Name
    If strName <> "" Then
        MsgBox "Åñòü èìÿ! " & vbCrLf & rngOne.Name
        rngOne.Interior.ColorIndex =  4 
        blnEmpty = False
    End If
'============================
    strName = ""
    strName = FindDependents(rngOne)
    
    If strName <> "" Then
        MsgBox "Åñòü çàâèñèìîñòè! " & vbCrLf & strName
        rngOne.Interior.ColorIndex =  4 
        blnEmpty = False
    End If
'============================
    strName = ""
    strName = FindPrecedents(rngOne)
    
    If strName <> "" Then
        MsgBox "Åñòü âëèÿíèå íà íå¸! " & vbCrLf & strName
        rngOne.Interior.ColorIndex =  4 
        blnEmpty = False
    End If
Next rngOne

If blnEmpty Then
MsgBox "Âñå ïóñòî!"
End If
End Sub
Function FindDependents(qq As Range) As String
Dim qd As Range
Dim i As Integer
    
On Error Resume Next
    i =  0 
    i = qq.Dependents.Count
    FindDependents = ""
    
    If i <>  0  Then
        For Each qd In qq.Dependents
            FindDependents = FindDependents & qd.Parent.Name & "!" & qd.Address & ";" & vbCrLf
            'qd.Interior.ColorIndex = 7
        Next qd
    End If
    

    Set qd = Nothing
End Function
Function FindPrecedents(qq As Range) As String
Dim qd As Range
Dim i As Integer
    
On Error Resume Next
    i =  0 
    i = qq.Precedents.Count
    FindPrecedents = ""
    
    If i <>  0  Then
        For Each qd In qq.Precedents
            FindPrecedents = FindPrecedents & qd.Parent.Name & "!" & qd.Address & ";" & vbCrLf
            'qd.Interior.ColorIndex = 8
        Next qd
    End If
    

    Set qd = Nothing
End Function

Sub DeleteUnboundNames()
Dim CurrentName As Name

    For Each CurrentName In ActiveWorkbook.Names
        If CStr(CurrentName.Value) Like "*REF!*" Then
            MsgBox "Name " & CurrentName.Name & " will be deleted on the address  " & CurrentName.Value
            CurrentName.Delete
        End If
    Next CurrentName
End Sub