Using the code from user3598756 works fine, Previous question, except up to 1 point.
If I want to delete the first team, nr 1, it gives me a popup to select a file. It wants to update/use a Sheet called BT0, which doesn't exist and never will exist. See screenshot.
BT1 is the first sheet of the list of sheets.
My question is how I can avoid this?
Screenshot
Sub Team_Verwijderen()
Dim Zoekwaarde As Variant Zoekwaarde = InputBox("Vul het BT-nummer in dat je wilt verwijderen.")
On Error GoTo Errohandler
Dim intMyVal As Long
intMyVal = CLng(Zoekwaarde) 'Value to search for, change as required.
Dim lngLastRow As Long, lngLastRowVBG As Long
lngLastRow = Blad1.Cells(Rows.Count, "A").End(xlUp).Row 'Search Column A, change as required.
lngLastRowVBG = Blad4.Cells(Rows.Count, "M").End(xlUp).Row 'Search Column M, change as required.
Dim foundCel As Range, foundCelVBG As Range ' look range A3:A... for the input value
Set foundCel = Blad1.Range("A3:A" & lngLastRow).Find(what:=intMyVal, LookIn:=xlValues, lookat:=xlWhole)
Set foundCelVBG = Blad4.Range("M3:M" & lngLastRow).Find(what:="BT" & intMyVal, LookIn:=xlValues, lookat:=xlWhole)
If foundCel Is Nothing Then
MsgBox "BT-Team niet gevonden!"
Else
'Application.DisplayAlerts = False
Sheets("BT" & intMyVal).Delete ' delete the worksheet
'Application.DisplayAlerts = True
Dim iRow As Long 'loop through sheets following the deleted one
For iRow = foundCel.Row + 1 To lngLastRow
Blad1.Cells(iRow, 1).Resize(, 1).Value = Array(intMyVal) 'rewrite the sequence and the name reference of the current loop sheet
Blad1.Cells(iRow, 1).Resize(, 1).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'BT" & intMyVal & "'!A1"
Sheets("BT" & intMyVal + 1).Name = "BT" & intMyVal ' rename the current loop sheet
Sheets("BT" & intMyVal).Range("A11").Formula = "=IF(OR(RC[2]=""JA"",RC[2]=""J""),'BT" & intMyVal - 1 & "'!R[279]C+1,'BT" & intMyVal - 1 & "'!R[279]C+0)"
intMyVal = intMyVal + 1
Next
If Range("A" & lngLastRow).Value <> 1 Then
Intersect(Blad1.Range("A:K"), foundCel.EntireRow).Delete xlUp '
Intersect(Blad4.Range("M:R"), foundCelVBG.EntireRow).Delete xlUp '
Else
Blad1.Range("B3:K3").ClearContents
Blad4.Range("M3:R3").Delete xlUp
Blad4.Range("F7:J9, F11:J18").ClearContents
End If
End If
Blad11.Select
Dim foundCelGemarkeerd As Range
Set foundCelGemarkeerd = Blad11.Range("C4:C253").Find(what:=0, LookIn:=xlValues, lookat:=xlWhole)
'MsgBox foundCelGemarkeerd
If foundCelGemarkeerd Is Nothing Then
Blad1.Range("B3").Select
Else
Intersect(Range("A:C"), foundCelGemarkeerd.EntireRow).Delete xlUp
End If
Blad1.Select Range("B3").Select
MsgBox "BT" & Zoekwaarde & " verwijderd!", vbOKOnly, "BT-team verwijderd"
Errohandler: Range("B3").Select
End Sub
Who can help me?
The problem is that I don't understand the loop part enough to see where it goes wrong and how to fix it.
If I delete team 1, it needs to start at sheet BT2 and rename to BT1. Now it looks like it wants to start at sheet BT0, which does not exist and never will.