Sub Удалить_проект()
    If Not Intersect(ActiveCell, Columns(2)) Is Nothing Then
        If IsEmpty(ActiveCell.Value) Then
            MsgBox "Данные о проектах полностью удалены", 64
        Else
            If MsgBox("Данные этого проекта будут полностью удалены. Продолжить?", vbYesNo) = vbYes Then ActiveCell.Value = Empty
        End If
    Else
        MsgBox "Выберете ячейку с названием проекта в колонке B и повторите действие еще раз", vbExclamation + vbOKOnly
    End If
End Sub

Sub Удалить_проект_Несколько()
Dim Vl, intCount As Long, intTest
With ActiveWorkbook
  With ActiveSheets
    If Intersect(ActiveCell, Columns(2)) Is Nothing Then ''' Если выделение вне столбца "Б"
       MsgBox "Выберете ячейку с названием проекта в колонке B и повторите действие еще раз", 48
    Else
      For Each Vl In Selection  ''' Анализ количества выделенных ячеек только столбца "Б"
        intCount = intCount + 1
        If Not IsEmpty(Vl.Value) And Vl.Column = 2 Then intTest = intTest + 1
      Next
      Select Case intCount
      Case Is = 1 ''' стандартная обработка одной ячейки
          Select Case intTest
            Case Is = 0: MsgBox "Данные о проектах полностью удалены", 64
            Case Else
               If MsgBox("Данные этого проекта будут полностью удалены. Продолжить?", 4) = 6 Then ActiveCell.Value = Empty
          End Select
      Case Else   ''' расширенная обработка нескольких ячеек
        Select Case intTest
          Case Is = 0: MsgBox "Данные о проектах полностью удалены", 64
          Case Else
             If MsgBox("Общее количество выделенных ячеек проектов колонки Б составило " & intTest & "штук. Продолжить?", 4) = 6 Then
                For Each Vl In Selection ''' Удаляем выделенные ячейки только столбца "Б"
                    If Not IsEmpty(Vl.Value) And Vl.Column = 2 Then Vl.Value = Empty
                Next
             End If
          End Select
      End Select
    End If
  End With
 End With
End Sub

Sub Удалить_проект_Несколько()
Dim cl As Range
Dim rngProject As Range
Dim strProject As String
If Intersect(Selection, Columns(2)).Count <> 0 Then
    For Each cl In Intersect(Selection, Columns(2)).Cells
        If Not IsEmpty(cl) Then
            If Not rngProject Is Nothing Then
                Set rngProject = Union(rngProject, cl, cl.Offset(, -1), cl.Offset(, 1), cl.Offset(, 3), cl.Offset(, 5), cl.Offset(, 7), cl.Offset(, 9))
                strProject = strProject & vbCrLf & cl.Value
            Else
                Set rngProject = Union(cl, cl.Offset(, -1), cl.Offset(, 1), cl.Offset(, 3), cl.Offset(, 5), cl.Offset(, 7), cl.Offset(, 9))
                strProject = cl.Value
            End If
        End If
    Next
    If Not IsEmpty(strProject) Then
        If MsgBox("Данные о проектах:" & vbCrLf & _
                    strProject & vbCrLf & "будут полностью удалены! Продолжить?", _
                    vbCritical + vbYesNo, "Внимание!") = vbYes Then rngProject.ClearContents
    Else
        MsgBox "Данные о проектах полностью удалены", 64
    End If
Else
    MsgBox "Выберете ячейку(диапазон) с названием проекта в колонке B и повторите действие еще раз", 48
End If
End Sub