Sub DeleteMultiplePages()

'Delete Multiple Pages by displaying Inputbox

Dim objRange As Range
Dim strPage As String
Dim objDoc As Document
Dim nSplitItem As Long
Dim oCol As Collection

    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")

    Set oCol = GetPages(strPage)

    ' Find specified pages and highlight their contents.
    For nSplitItem = oCol.Count To 1 Step -1
        With ActiveDocument
            Selection.GoTo What:=wdGoToPage, which:=wdGoToAbsolute, Count:=Split(strPage, ",")(oCol(spliitem))
            Set objRange = .Bookmarks("\Page").Range
            objRange.Delete
        End With
    Next nSplitItem

    Application.ScreenUpdating = True
End Sub

Private Function GetPages(sRange As String) As Collection
Dim vRange As Variant
Dim oCol As Collection
Dim i As Integer, j As Integer
Dim iStart As Integer, iEnd As Integer
    Set oCol = New Collection
    On Error Resume Next
    vRange = Split(sRange, ",")
    For i = 0 To UBound(vRange)
        Select Case True
            Case InStr(1, vRange(i), "-") > 0
                iStart = CInt(Split(CStr(vRange(i)), "-")(0))
                iEnd = CInt(Split(CStr(vRange(i)), "-")(1))
                For j = iStart To iEnd
                    oCol.Add Trim(j)
                Next j
            Case Else
                oCol.Add vRange(i)
        End Select
    Next i
    Set GetPages = oCol
End Function