Delete Row and Rename Worksheets From cell value

Question

I've a list on the first worksheet cooresponding tot the worksheet name.

List is from 1 to ... and the name of worksheet is BT1, BT2, ....

Now Have I created a macro to delete a row from the list ande delete the specific worksheet, but after when the worksheet is deleted the rem2aining worksheets have to be renamed corresponding the numeric list.

Let say I delete Team 3, the teams are from 1 to 10. The code deletes the corresponding row and sheet, then it has first change the cell formula in the Cell (A?), so the list list is reset from 1 t0 9 and then changes the worksheet name.

I know that I need a loop for that, but don't know/understand how to write this type code.

I have the following Macro written. At the point of 'Loop to Rename worksheets I wanted to create a loop the rename the worksheets, but don't know/understand how to write the code.

Sub Team_Verwijderen()

Dim intMyVal As Integer, a As Integer
Dim lngLastRow As Long, i As Long
Dim strRowNoList As String, List2 As String, List_1 As String
Dim Zoekwaarde As Variant
Dim cell As Variant
Dim naam$, laatsteNaam$

Zoekwaarde = InputBox("Vul het Teamnummer in dat je wilt verwijderen.")

On Error GoTo Errorhandler

intMyVal = Zoekwaarde 'Value to search for, change as required.
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Search Column A, change as required.

For Each cell In Range("A3:A" & lngLastRow) 'Starting cell is A2, change as required.

    If cell.Value = intMyVal Then
        If strRowNoList = "" Then
        strRowNoList = strRowNoList & cell.Row
        Else
        strRowNoList = strRowNoList & ", " & cell.Row
        End If
    End If
Next cell

List2 = strRowNoList
List_1 = Range("A" & strRowNoList).Value

Sheets("BT" & List_1).Delete
Blad1.Range("A" & strRowNoList & ":K" & strRowNoList).Delete xlUp

'Loop to Rename worksheets
naam = "BT" & List_1



Range("A" & List2).Formula = "=if(B" & List2 & "="""","""",A" & List2 - 1 & "+1)"
Sheets("BT" & List_1 + 1).Name = naam
                


'-------------------------
Errorhandler:

Blad1.Select
Range("B3").Select

End Sub

could you add some screenshots of a "before" and "after" scenario? — user3598756
– user3598756, Commented Nov 26, 2023 at 15:21

user3598756 · Accepted Answer · 2023-11-26 15:59:58Z

you don't need a loop to look for the input value: just go with the Find() method of Range object

Option Explicit

Sub Team_Verwijderen()    

    Dim Zoekwaarde As Variant
        Zoekwaarde = InputBox("Vul het Teamnummer in dat je wilt verwijderen.")            
        Dim intMyVal As Long
            intMyVal = CLng(Zoekwaarde) 'Value to search for, change as required.
            
        Dim lngLastRow As Long
            lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Search Column A, change as required.
            
            Dim foundCel As Range ' look range A3:A... for the input value 
            Set foundCel = Range("A3:A" & lngLastRow).Find(what:=intMyVal, LookIn:=xlValues, lookat:=xlWhole)
                If foundCel Is Nothing Then
                    MsgBox "Value not found!"
                Else
                    Application.DisplayAlerts = False
                        Sheets("BT" & intMyVal).Delete ' delete the worksheet
                    Application.DisplayAlerts = False
                    
                    Dim iRow As Long 'loop through sheets following the deleted one
                        For iRow = foundCel.Row + 1 To lngLastRow
                            Cells(iRow, 1).Resize(, 2).Value = Array(intMyVal, "BT" & intMyVal) 'rewrite the sequence and the name reference of the current loop sheet 
                            Sheets("BT" & intMyVal + 1).Name = "BT" & intMyVal ' rename the current loop sheet
                            intMyVal = intMyVal + 1
                        Next
                        
                        Intersect(Range("A:K"), foundCel.EntireRow).Delete xlUp '
                End If

                    Range("B3").Select

End Sub

Which can be condensed a little bit as follows:

Option Explicit

Sub Team_Verwijderen()
        
    Dim intMyVal As Long
        intMyVal = CLng(InputBox("Vul het Teamnummer in dat je wilt verwijderen.")) 'Value to search for, change as required.
        
    With Range("A3", Cells(Rows.Count, "A").End(xlUp)) 'reference the range with the number sequence
        Dim foundCel As Range
        Set foundCel = .Find(what:=intMyVal, LookIn:=xlValues, lookat:=xlWhole) ' look the referenced range for the searche value
            If foundCel Is Nothing Then
                MsgBox "Value not found!"
            Else ' if found
                Application.DisplayAlerts = False
                    Sheets("BT" & intMyVal).Delete ' delete the corresponding sheet
                Application.DisplayAlerts = False
                
                Dim iRow As Long
                    For iRow = foundCel.Row + 1 To .Rows(.Rows.Count).Row ' loop through the sheets following the deleted one
                        Cells(iRow, 1).Resize(, 2).Value = Array(intMyVal, "BT" & intMyVal) ' update the current loop sheet number sequence and name
                        Sheets("BT" & intMyVal + 1).Name = "BT" & intMyVal ' update the current loop sheet name
                        intMyVal = intMyVal + 1
                    Next
                    
                    Intersect(Range("A:K"), foundCel.EntireRow).Delete xlUp 'delete the serached sheet data
            End If
    End With

        Range("B3").Select

End Sub

Mark · Accepted Answer · 2023-11-26 21:08:53Z

0

' Loop to Rename worksheets
For i = List_1 + 1 To lngLastRow - 2 ' assuming you have 10 teams and starting from 3rd row
    naam = "BT" & i
    Range("A" & i + 2).Formula = "=IF(B" & i + 2 & "="""","""",A" & i + 1 & "+1)"
    Sheets("BT" & i + 1).Name = naam
Next i

' -------------------------

Exit Sub ' Exit the subroutine after successful execution

The For-Loop above should be able to manage the task as you described. It iterates through the remaining worksheets and updates their names based on the numeric list. Note that I used lngLastRow - 2 as the upper limit for the loop assuming you have 10 teams starting from the 3rd row. Adjust this value accordingly based on your actual data structure.

edited Nov 26, 2023 at 21:08

answered Nov 26, 2023 at 15:41

Mark

751 silver badge7 bronze badges

Collectives™ on Stack Overflow

Delete Row and Rename Worksheets From cell value

2 Answers 2

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related