Split function by comma and hyphen simultaneously

laith93 · #1 08-15-2021, 01:12 AM

Hello, forums members,

I have this code to delete multiple pages

Code:

Sub DeleteMultiplePages()

'Delete Multiple Pages by displaying Inputbox

  Dim objRange As range
  Dim strPage As String
  Dim objDoc As Document
  Dim nSplitItem As Long

  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")
  nSplitItem = UBound(Split(strPage, ","))

  ' Find specified pages and highlight their contents.
  For nSplitItem = nSplitItem To 0 Step -1
    With ActiveDocument
      Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=Split(strPage, ",")(nSplitItem)
      Set objRange = .Bookmarks("\Page").range
      objRange.Delete
    End With
  Next nSplitItem
 
  Application.ScreenUpdating = True
End Sub

The code works fine, but my problem is that sometimes I want to delete continuous pages range in addition to a certain page, eg: 1-3,5,10-15. Hence, I want to use split function in the previous code: nSplitItem = UBound(Split(strPage, ",")) based on comma and hyphen eg: 1-3,5,10-15, or just comma eg: 1,5,9 or just hyphen eg: 1-10.

Thank you

Guessed · #2 08-15-2021, 04:02 AM

Before you create nSplitItem, you should call a function to tidy the string and expand the number ranges. Something like this should work

Code:

Sub TestFun()
  MsgBox funExpandDashes("1-3,5,10-15")
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, ",")
  
  'Add code here to make sure order is increasing (ie sort array)
  'Add code here to remove duplicates
 
End Function

Note the two suggestions to make this more robust and reduce user data entry issues

laith93 · #3 08-15-2021, 04:36 AM

Quote:

Originally Posted by Guessed

Before you create nSplitItem, you should call a function to tidy the string and expand the number ranges. Something like this should work

Thank you Mr. Guessed for the second reply to me
Mr. Guessed, excuse me I'm just a beginner in VBA, and the code is not my own development, I just googled and found it.
However, I pasted your function as follows:

Code:

Sub TestFun()
  MsgBox funExpandDashes("1-3,5,10-15")
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
  
  'Add code here to make sure order is increasing (ie sort array)
  Sub DeleteMultiplePages()

'Delete Multiple Pages by displaying Inputbox

  Dim objRange As range
  Dim strPage As String
  Dim objDoc As Document
  Dim nSplitItem As Long

  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")
  nSplitItem = funExpandDashes

  ' Find specified pages and highlight their contents.
  For nSplitItem = nSplitItem To 0 Step -1
    With ActiveDocument
      Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=Split(strPage, ",")(nSplitItem)
      Set objRange = .Bookmarks("\Page").range
      objRange.Delete
    End With
  Next nSplitItem
 
  Application.ScreenUpdating = True
End Sub

  'Add code here to remove duplicates
 
End Sub

In conclusion, I faced a problem, so how to call a function in VBA?
Thank you for sharing your knowledge.

Guessed · #4 08-15-2021, 04:40 AM

Add this line (shown in Red) into the Sub you already have

Code:

  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 = UBound(Split(strPage, ","))

You should make the above change to what you already had shown in the first post.
The Function I provided goes either before or after all the code you had. You can delete the short test sub I provided - it isn't necessary.

laith93 · #5 08-15-2021, 04:58 AM

Quote:

Originally Posted by Guessed

Add this line (shown in Red) into the Sub you already have

Code:

  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 = UBound(Split(strPage, ","))

I'm sorry for annoying Mr. Guessed
The following error has appeared:

112.png

error line: objRange.Delete

This is the full code that I used:

Code:

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
  
  'Add code here to make sure order is increasing (ie sort array)
  Sub DeleteMultiplePagessssssssssssss()

'Delete Multiple Pages by displaying Inputbox

  Dim objRange As range
  Dim strPage As String
  Dim objDoc As Document
  Dim nSplitItem As Long

  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 = UBound(Split(strPage, ","))

  ' Find specified pages and highlight their contents.
  For nSplitItem = nSplitItem To 0 Step -1
    With ActiveDocument
      Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=Split(strPage, ",")(nSplitItem)
      Set objRange = .Bookmarks("\Page").range
      objRange.Delete
    End With
  Next nSplitItem
 
  Application.ScreenUpdating = True
End Sub

Guessed · #6 08-15-2021, 05:09 AM

Try this version

Code:

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

gmayor · #7 08-15-2021, 05:16 AM

I started to answer but was distracted by a Skype call, and I see Andrew has been busy in the meantime, but the following alternative should work, using a function to get the page numbers

Code:

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

laith93 · #8 08-15-2021, 05:30 AM

Quote:

Originally Posted by Guessed

Try this version

Fantastic,
Thank you so much, Mr. Andrew, the code works fine.

Just I want to increase my info in VBA, why we used this line again

Code:

 nSplitItem = Split(strPage, ",")

Also, the delimiter of split function is "," not ", & -" after editing the code
Can you explain as you can, otherwise ignore it.

Thank you again

laith93 · #9 08-15-2021, 05:44 AM

Quote:

Originally Posted by gmayor

but the following alternative should work, using a function to get the page numbers

Thank you Mr. gmayor

The code of Mr. Andrew works fine without any problem

I think you have a problem (Subscript out of range) with your code in the line:

Code:

 Selection.GoTo What:=wdGoToPage, which:=wdGoToAbsolute, Count:=Split(strPage, ",")(oCol(spliitem))

You can solve it, otherwise, ignore it and take your rest.

Thank you.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Mistake in the help file for String "Split Function"?	John 4	Word VBA	6	11-19-2020 06:02 AM
Hyphen until the end of the row	abc3132	Word	13	10-31-2019 04:36 AM
Split function in Excel (split the screen)	Officer_Bierschnitt	Excel	1	07-05-2017 07:02 AM
Split function not working as I expect??!!	XmisterIS	Word VBA	9	04-08-2014 04:41 PM
Cross-reference function to update bullet header and number simultaneously	dljenks	Word	1	01-03-2014 01:38 PM