Sub DeleteMultiplePagessssssssssssss()
'Delete Multiple Pages by displaying Inputbox

  Dim objRange As Range, strPage As String, objDoc As Document, nSplitItem() As String, iCounter As Integer

  Application.ScreenUpdating = False
 
    ' Initialize and enter page numbers of pages to be deleted.
    Set objDoc = ActiveDocument
    strPage = InputBox("Enter the page numbers of pages to be deleted: " & vbNewLine & _
              "use comma to separate numbers", "Delete Pages", "For example: 1,3")
    strPage = funExpandDashes(strPage)
    nSplitItem = Split(strPage, ",")
  
    ' Find specified pages and highlight their contents.
    For iCounter = UBound(nSplitItem) To 0 Step -1
      With objDoc
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=nSplitItem(iCounter)
        Set objRange = .Bookmarks("\Page").Range
        objRange.Delete
      End With
    Next iCounter
 
  Application.ScreenUpdating = True
End Sub

Function funExpandDashes(strPage As String) As String
  Dim arrOuter() As String, iMin As Integer, iMax As Integer, arrInner() As String, sExpand As String
  Dim x As Integer, y As Integer

  strPage = Replace(strPage, " ", "")     'make sure there are no spaces
  arrOuter = Split(strPage, ",")
  For x = LBound(arrOuter) To UBound(arrOuter)
    arrInner = Split(arrOuter(x), "-")
    If UBound(arrInner) > LBound(arrInner) Then
      sExpand = arrInner(0)
      For y = CInt(arrInner(0)) + 1 To CInt(arrInner(1))
        sExpand = sExpand & "," & y
      Next y
      arrOuter(x) = sExpand
    End If
  Next x
  funExpandDashes = Join(arrOuter, ",")
End Function