VBA multipage adding and deleting page

[pepsimus]

Hi can someone help me with this code. I am trying delete pages in multipage with diferent names and renaming them back.

this code works fine but only when page name is "pozice" + number
when i have pages pozice1, pozice2, pozice3, pozice4 then for example delete page pozice2 it will change name of pozice3 to pozice2 and name of pozice4 to pozice3

Private Sub btndeletepage_Click()
    Dim i As Integer
    
    
    With Me.multipage1
        If .Pages.Count > 1 Then
            .Pages.Remove .Value
            If .Pages.Count > 0 Then
                For i = .Value To .Pages.Count - 1
                    .Pages(i).Caption = "pozice " & i + 1
                Next i
                
             End If
            Else
            MsgBox " Nemůžeš vymazat všechny pozice "
        End If

    End With
        Application.DisplayAlerts = False
        If i <> 0 Then
        Sheets("výpočet" & i + 1).Delete
        End If
        Application.DisplayAlerts = True
End Sub

but id like to change it so it will delete pages with diferent names.X1, Y2, X3, Y4, Y5 and so on. This code works fine when i delete last page but when i delate page in middle for example Y2 it will make it as X1, X3, Y4 and so on. instead of X1, X2, Y3, Y4

	
	

		
Private Sub btndeletepage_Click()
    Dim i As Integer
    Dim ci As Integer
    
    With Me.multipage1
        If .Pages.Count > 1 Then
            .Pages.Remove .Value
            If .Pages.Count > 0 Then
              If .Pages(i).Caption = "Obdelník" & i Then
                For i = .Value To .Pages.Count - 1
                    .Pages(i).Caption = "Obdelník " & i + 1
                    Next i
                 ElseIf .Pages(i).Caption = "Mezikruží" & i Then
                    For i = .Value To .Pages.Count - 1
                    .Pages(i).Caption = "Mezikruží " & i + 1
                    Next i
                 End If
               'ci = multipage1.Pages.Count
               Application.DisplayAlerts = False
               'Sheets("calc" & i + 1).Delete
               Application.DisplayAlerts = True
              End If
           Else
            MsgBox " Nemůžeš vymazat všechny pozice "
        End If

    End With
        


End Sub

/CODE]
	

Can someone help me with this? i think problem is when i click delete page it will lose value of (i)

 

[johnnyL]

Try setting your deleting loop to loop backwards so that it deletes from the highest numbers first, that way it won't effect the numbers below it.

 

[pepsimus]

Deleting pages backwards works fine, but its necessary to make it work from midle as well. do you have any ideas how to make it work?

 

[johnnyL]

Please post the current version of the code that you are trying as well as specific examples of where it does not work as you want it to. ie. middle?

 

[pepsimus]

here is my code i chaged it little bit, so i dont use my country lanuage so it should work for everyone.

Download Data package from September 4th.

Free transfer of up to 6 GB of photos, videos and documents. Send large files via email or a link to share. No registration, no ads, just simple file sharing!

filetransfer.io

second deletepage button works fine, but ulny for same page names.

 

[johnnyL]

Let us know if this does what you want: It will keep the names, only the numbers are changed.

Private Sub CommandButton1_Click()
    Dim i                       As Long
    Dim j                       As Long
    Dim PageNameAndNumberLength As Long
    Dim PageNameAndNumber       As String
    Dim PageNameOnly            As String
'
    With Me.MultiPage1
        If .Pages.Count > 1 Then
            .Pages.Remove .Value
            If .Pages.Count > 0 Then
                For i = .Value To .Pages.Count - 1
                    PageNameAndNumber = .Pages(i).Caption                           ' Get Name of tab
                    PageNameAndNumberLength = Len(PageNameAndNumber)                ' Get the total length of the Name
'
                    For j = PageNameAndNumberLength To 1 Step -1                    ' Start checking from the right side of the Name for the first non numeric character
                        If Not (IsNumeric(Mid(PageNameAndNumber, j, 1))) Then       '   If non numeric character found then ...
                            PageNameOnly = Left(PageNameAndNumber, j)               '       Save it & all characters to the left
                            Exit For                                                '       Exit loop
                        End If
                    Next
'
                    .Pages(i).Caption = PageNameOnly & i + 1                        ' add new number to the end of PageName
                Next i
             End If
        Else
            MsgBox " Nemùžeš vymazat všechny pozice "
        End If
    End With
End Sub

 

[pepsimus]

thank you very much, that works perfectly.

 

[johnnyL]

Glad to help.

 

[pepsimus]

can i ask you one more question?
i´d like to connect text boxes with cell values dynamicaly, if its possible. now deleting pages works fine and adding new ones as well. but when i delete page in middle connecting with textboxes are mixed up. is it possible to make it when i delete page in middle, cell connections will still corespond ?
here is my example:

Download Data package from September 6th.

Free transfer of up to 6 GB of photos, videos and documents. Send large files via email or a link to share. No registration, no ads, just simple file sharing!

filetransfer.io

 

[pepsimus]

hello, nobody knows if its possible? i cant figure it out.