VBA rename sheets based on Inputbox cell value - vba

Question

I would like to rename sheets based on the same cell within each sheet. When i run the macro rather than having the cell predefined I would like to use an input box to define what cell the sheets are to be named after. This is what I have so far- currently it works for only cell C8.
Sub RenameSheet()
Dim ws As Worksheet
For Each ws In Worksheets
On Error Resume Next
If Len(ws.Range("C8")) > 0 Then
ws.Name = ws.Range("C8").Value
End If
On Error GoTo 0
If ws.Name <> ws.Range("C8").Value Then
MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
End If
Next
End Sub
I think this code would help but I cannot get it to run
Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
Anyone have help on this?

Answer 1

I suggest the following changes.
Also it would be a good idea to activate the current sheet so the user always automatically selects a cell on the correct sheet.
Option Explicit
Public Sub RenameSheet()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate 'so we automatically are on the correct sheet to select a range
Dim CellID As Range
Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
If CellID.Count > 1 Then 'check how many cells were selected
MsgBox "Please select only one cell!", vbExclamation
Exit Sub
End If
If Len(CellID.Value) > 0 Then
On Error Resume Next
ws.Name = CellID.Value
'catch the error
If Err.Number <> 0 Then MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
On Error GoTo 0
Else
MsgBox ws.Name & " Was Not renamed, the suggested name was empty"
End If
Next ws
End Sub
Alternative to select the address once and use the same address on every worksheet.
Option Explicit
Public Sub RenameSheet()
Dim CellID As Range
Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
If CellID.Count > 1 Then 'check how many cells were selected
MsgBox "Please select only one cell!", vbExclamation
Exit Sub
End If
Dim NameAddress As String
NameAddress = CellID.Address(External:=False)
Dim ws As Worksheet
For Each ws In Worksheets
If Len(ws.Range(NameAddress).Value) > 0 Then
On Error Resume Next
ws.Name = ws.Range(NameAddress).Value
If Err.Number <> 0 Then MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
On Error GoTo 0
Else
MsgBox ws.Name & " Was Not renamed, the suggested name was empty"
End If
Next ws
End Sub

Answer 2

This should work for you:
Sub RenameSheet()
Dim ws As Worksheet, CellID As Range
For Each ws In ThisWorkbook.Worksheets
Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
Set CellID = ws.Cells(CellID.Row, CellID.Column)
On Error Resume Next
ws.Name = CellID
On Error GoTo 0
If ws.Name <> CellID.Value Then
MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
End If
Next
End Sub
This code will set your range twice, because the inputbox assumes ActiveSheet, as there's no way to assign the worksheet name to your input range without typing it out.
Therefore, once you type in the cell address, it will utilize the .Row and .Column properties of the inputrange of the activesheet, while assigning them to the correct worksheet since we didn't qualify the worksheet in CellID.Row and CellID.Column.