I am using the below code to rename worksheet.
Option Explicit
Sub RenWSs()
Dim ws As Worksheet
Dim shtName
Dim newName As String
Dim i As Integer
Dim RngStr As String
RngStr = Application.InputBox(prompt:="Select the Range for the new Sheet's name", Type:=2)
For Each ws In Worksheets
With ws
If Trim(.Range(RngStr)) <> "" Then
shtName = Split(Trim(.Range(RngStr)), " ")
newName = shtName(0)
On Error GoTo ws_name_error
.Name = .Range(RngStr)
GoTo done
repeat:
.Name = newName & i
GoTo done
ws_name_error:
i = i + 1
Resume repeat
End If
End With
On Error GoTo 0
done:
Next
End Sub
In this i am selecting the new name through Input Box and its working fine. Now what i want is, before calling the input box, the below process has to be done.
I have names in drop down list, each names in drop down list to be updated one by one in all worksheets like J16 is the cell.
Please help me
The code below will lopp through all ws sheets, and modifies the value of cell in "J16" to "Test 1" (just for testing purposes).
Option Explicit
Sub ModifyDropDownValue()
Dim ws As Worksheet
For Each ws In Worksheets
With ws
' modify the value in cell J16
.Range("J16").Value = "Test 1"
End With
Next ws
End Sub
Related
Hi i am trying to copy from a master template and rename a the copy worksheet in excel VBA i was using Date which worked great but now I am trying to rename the copy of the master to DATA 1 and then the next time the new sheet would be DATA 2
Private Sub Workbook_Open()
Dim iThisMonth As Integer, iLastMonth As Integer
Dim datLastRun As Date
Dim rCheckCell As Range
Set rCheckCell = Sheets("master").Range("A5")
Set Target = Range("V16")
On Error Resume Next
datLastRun = CDate(rCheckCell.Value)
iLastMonth = Month(datLastRun)
On Error GoTo 0
If Target.Value = "yes" Then
MsgBox "Call Peter"
Call Peter
rCheckCell.Value = Format(Now(), "dd/mmm/yy")
End If
End Sub
Macro Code
Sub Peter()
Sheets("Master").Visible = True
Sheets("Master").Copy After:=Worksheets(Worksheets.Count)
NewPageName = Data1
ActiveWindow.ActiveSheet.Name = NewPageName
End Sub
Create a basic function like below which will give you the next available name. For example, if there is a worksheet with the name Data1 and Data2, then the below function will return Data3
Private Function NewDataName() As String
Dim ws As Worksheet
Dim i As Long: i = 1
Dim shtname As String
Do
'~~> Create a worksheet name
shtname = "DATA" & i
'~~> Check if we already have a worksheet with that name
On Error Resume Next
Set ws = ThisWorkbook.Sheets(shtname)
On Error GoTo 0
'~~> If no worksheet with that name then return name
If ws Is Nothing Then
NewDataName = shtname
Exit Do
Else
i = i + 1
Set ws = Nothing
End If
Loop
End Function
And the usage will be like
Sub Peter()
Sheets("Master").Visible = True
Sheets("Master").Copy After:=Worksheets(Worksheets.Count)
ActiveWindow.ActiveSheet.Name = NewDataName
End Sub
So, say for instance I have 2 sheets in my workbook... Page1 and OldName.
On sheet Page1 in cell A1 there is the value OldName (where "OldName" happens to be sheet name of the sheet I would like to rename).
Also on Page1 in cell A2, there is the value NewName (where "NewName" is the name I would like to change the sheet specified in cell A1 to).
I am Trying to come up with code that uses the the cell A1 to identify which sheet I would like to rename and then use the cell A2 as the source for the rename value.
Any suggestions?
You may try something along these lines:
Sub Test()
Dim sht As Worksheet
With ThisWorkbook
For Each sht In .Worksheets
If sht.Name = .Worksheets("Page1").Cells(1, 1).Value Then
sht.Name = .Worksheets("Page1").Cells(2, 1).Value
Exit For
End If
Next
End With
End Sub
try this simple loop
Sub ChangeNameLoop()
Dim wb As Workbook
Dim ws As Worksheet
Dim OldName As String, NewName As string
Set wb = ThisWorkbook
OldName = ActiveSheet.Range("A1") ' location of names
NewName = ActiveSheet.Range("A2")
For Each ws In wb.Worksheets
If ws.Name = OldName Then
ws.Name = NewName
End If
Next ws
End Sub
No need to loop. This will do what you want. This code will replace the sheet name if found else will do nothing.
Option Explicit
Sub Sample()
On Error Resume Next
With ThisWorkbook
.Sheets(.Sheets("Page1").Cells(1, 1).Value2).Name = _
.Sheets("Page1").Cells(2, 1).Value2
End With
On Error GoTo 0
End Sub
Or something like this
Option Explicit
Sub Sample()
Dim ws As Worksheet
With ThisWorkbook
On Error Resume Next
Set ws = .Sheets(.Sheets("Page1").Cells(1, 1).Value2)
On Error GoTo 0
If Not ws Is Nothing Then ws.Name = _
.Sheets("Page1").Cells(2, 1).Value2
End With
End Sub
I have the below code I use to jump to sheets. It requires the exact name to typed in order to be found. Is there a way to have it jump to a sheet by typing in part of the sheet name?
For example, I have a large workbook with sheets named by their ID and currency. If I know the ID but not the currency I would like to be able to jump to the sheet.
My code:
Sub SelectSheet()
Dim i As Variant
Dim ws As Worksheet
i = Application.InputBox("Enter worksheet name", "Select sheet")
'Cancel was pressed
If i = False Or Trim(i) = "" Then Exit Sub
'Check if sheet exist
On Error Resume Next
Set ws = Sheets(i)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Worksheet " & i & " not found!"
Else
Sheets(i).Select
End If
End Sub
Any ideas?
This will do a partial name match on the beginning of each sheet name. Adjust accordingly to fit your needs.
It works by matching the first x number of characters of each sheet name, where the value of x is determined by the number of characters you entered. You may need to handle case-conversion (e.g., converting the input to uppercase to remove case-sensitivity).
Sub SelectSheet()
Dim Temp As Variant
Dim ws As Worksheet
Temp = Application.InputBox("Enter worksheet name", "Select sheet")
'Cancel was pressed
If Temp = False Or Trim(Temp) = "" Then Exit Sub
'Check if sheet exist
On Error Resume Next
For i = 1 To Sheets.Count
If Left(Sheets(i).Name, Len(Temp)) = Temp Then ' Match first letters
Set ws = Sheets(i) ' Found it
End If
Next
Set ws = Sheets(i)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Worksheet " & Temp & " not found!"
Else
ws.Select
End If
End Sub
How can i rename a sheet and add a number to the end of the name if the name already exists.
I'm using this code but need to add a number to the end of sheet name if name already exists.
VBA_BlankBidSheet.Copy After:=ActiveSheet
ActiveSheet.Name = "New Name"
The code below loops through all worksheets in ThisWorkbook and checks if there is already a sheet with a name of "New Name", if it does it adds a number at the end.
Sub RenameSheet()
Dim Sht As Worksheet
Dim NewSht As Worksheet
Dim VBA_BlankBidSheet As Worksheet
Dim newShtName As String
' modify to your sheet's name
Set VBA_BlankBidSheet = Sheets("Sheet1")
VBA_BlankBidSheet.Copy After:=ActiveSheet
Set NewSht = ActiveSheet
' you can change it to your needs, or add an InputBox to select the Sheet's name
newShtName = "New Name"
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = "New Name" Then
newShtName = "New Name" & "_" & ThisWorkbook.Sheets.Count
End If
Next Sht
NewSht.Name = newShtName
End Sub
The test procedure on a new workbook will generate these sheet names:
Sheet1_1, Sheet2_1 and ABC.
If Sheet1_1 exists and we ask for a new Sheet1 it will return Sheet1_2, as ABC doesn't exist in a new workbook it will return ABC.
The Test code adds a new sheet called 'DEF'. If you run it a second time it will create 'DEF_1'.
Sub Test()
Debug.Print RenameSheet("Sheet1")
Debug.Print RenameSheet("Sheet2")
Debug.Print RenameSheet("ABC")
Dim wrkSht As Worksheet
Set wrkSht = Worksheets.Add
wrkSht.Name = RenameSheet("DEF")
End Sub
Public Function RenameSheet(SheetName As String, Optional Book As Workbook) As String
Dim lCounter As Long
Dim wrkSht As Worksheet
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
lCounter = 0
On Error Resume Next
Do
'Try and set a reference to the worksheet.
Set wrkSht = Book.Worksheets(SheetName & IIf(lCounter > 0, "_" & lCounter, ""))
If Err.Number <> 0 Then
'If an error occurs then the sheet name doesn't exist and we can use it.
RenameSheet = SheetName & IIf(lCounter > 0, "_" & lCounter, "")
Exit Do
End If
Err.Clear
'If the sheet name does exist increment the counter and try again.
lCounter = lCounter + 1
Loop
On Error GoTo 0
End Function
Edit: Removed the Do While bNotExists as I wasn't checking bNotExists - just using Exit Do instead.
Building on Darren's answer, I thought it might be easier to just rename the sheet right away instead of returning the name that can be used. I also refactored a bit. Here's my take:
Private Sub nameNewSheet(sheetName As String, newSheet As Worksheet)
Dim named As Boolean, counter As Long
On Error Resume Next
'try to name the sheet. If name is already taken, start looping
newSheet.Name = sheetName
If Err Then
If Err.Number = 1004 Then 'name already used
Err.Clear
Else 'unexpected error
GoTo nameNewSheet_Error
End If
Else
Exit Sub
End If
named = False
counter = 1
Do
newSheet.Name = sheetName & counter
If Err Then
If Err.Number = 1004 Then 'name already used
Err.Clear
counter = counter + 1 'increment the number until the sheet can be named
Else 'unexpected error
GoTo nameNewSheet_Error
End If
Else
named = True
End If
Loop While Not named
On Error GoTo 0
Exit Sub
nameNewSheet_Error:
'add errorhandler here
End Sub
The .net version of VB uses the Try ... Catch formulation to catch runtime errors, see {https://msdn.microsoft.com/en-us/library/ms973849.aspx}(https://msdn.microsoft.com/en-us/library/ms973849.aspx) for a comparison with the old "on error" formulation of VB6 and before. It is better suited to do what you want, and will make shorter exception runs imho.
I'm trying to find out what exception is thrown when trying to rename to an existing sheetname, and will edit here to a workable script when i find it.
I am looking for a code to create sheets with the name in column A. I have used this code but it is not fulfulling my requirement. The code is ;
Private Sub CommandButton1_Click()
Dim sheetCount As Integer
Dim sheetName As String
Dim workbookCount As Integer
With ActiveWorkbook
sheetCount = Sheets(1).Range("A2").End(xlDown).Row
For i = 2 To sheetCount Step 1
sheetName = .Sheets(1).Range("A" & i).Value
workbookCount = .Worksheets.Count
.Sheets.Add After:=Sheets(workbookCount)
.Sheets(i).Name = sheetName
'.Sheets(i).Range("A" & i, "F" & i).Value = .Sheets("sample").Range("A" & i, "F" & i).Value
Next
End With
Worksheets(1).Activate
End Sub
Upon running this code in first go, it creates sheets with the text present in column A. But the problem is when i entered new text in that column, it makes previous sheets as well. I am looking for a code which only create the sheets with the new text being entered in the column and donot make sheets which are already made. Kindly help me out on this as i tried too much but didnt find any code.
Thanks
This works for me, and is tested: Note, if you try to use a name like "History" that is reserved you will get an error. I am not aware of all the reserved names.
Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim sheetName As String
Dim workbookCount As Long
Dim ws As Worksheet
Dim match As Boolean
lastRow = Sheets("Sheet1").Range("A2").End(xlDown).Row
For i = 2 To lastRow
match = False
sheetName = Sheets("Sheet1").Cells(i, 1).Text
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = sheetName Then
match = True
End If
Next
If match = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sheetName
End If
Next i
End Sub
Edit: Added Screen Shots
You can try thi function:
Function SheetExists(SheetName As String) As Boolean
Dim Test As Boolean
On Error Resume Next
Test = Sheets(SheetName).Range("A1").Select
If Test Then
SheetExists = True
Else
SheetExists = False
End If
End Function
Using the function this way:
Sub test()
If SheetExists("MySheet") Then
MsgBox "Sheet exists"
Else
MsgBox "Sheet is missing"
End If
End Sub
I usually have these two helper functions in my workbooks / personal workbook
Option Explicit
Function getSheetWithDefault(name As String, Optional wb As Excel.Workbook) As Excel.Worksheet
If wb Is Nothing Then
Set wb = ThisWorkbook
End If
If Not sheetExists(name, wb) Then
wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).name = name
End If
Set getSheetWithDefault = wb.Sheets(name)
End Function
Function sheetExists(name As String, Optional wb As Excel.Workbook) As Boolean
Dim sheet As Excel.Worksheet
If wb Is Nothing Then
Set wb = ThisWorkbook
End If
sheetExists = False
For Each sheet In wb.Worksheets
If sheet.name = name Then
sheetExists = True
Exit Function
End If
Next sheet
End Function
To create the worksheets you just iterate over the sheet names and use the getSheetwithDefault function
The following code demonstrate this:
sub createSheets()
dim cursor as Range: set cursor = Sheets("Sheet1").Range("A2")
while not isEmpty(cursor)
getSheetWithDefault(name:=cursor.value)
set cursor = cursor.offset(RowOffset:=1)
wend
end