#1
|
|||
|
|||
Split function by comma and hyphen simultaneously
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 Thank you |
#2
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
Quote:
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. |
#4
|
||||
|
||||
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, ",")) 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.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
|||
|
|||
Quote:
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 |
#6
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#8
|
|||
|
|||
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, ",") Can you explain as you can, otherwise ignore it. Thank you again |
#9
|
|||
|
|||
Quote:
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)) Thank you. |
Tags |
word 19, word vba, word vba code |
Thread Tools | |
Display Modes | |
|
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 |