Its been a long time. I need a VBA to name my sheets Test 1, Test 2 etc from the active sheet and all to the right.
OR do the same for all selected sheets. IE, I'd select a block of 10 sheets and run my macro to rename them "Test 1,...Test 10"
it doesn't matter which method but there are sheets that I don't want the names changed so I either need the following to work ONLY on a block of selected sheets OR from an active sheet and all to the right.
I'm working from the following code:
Sub nameShts()
Dim i As Integer
For i = 1 To Worksheets.Count
Worksheets(i).Name = "Week" & i
Next i
End Sub
You were close for idea to loop from selected sheet to last sheet. Instead of 1 to Worksheets.Count use ActiveSheet.Index to Worksheets.Count
Sub nameShts()
Dim i As Integer
For i = ActiveSheet.Index To Worksheets.Count
Worksheets(i).Name = "Week" & i
Next i
End Sub
To loop the selected sheets, use ThisWorkbook.Windows(1).SelectedSheets to get a collection of the selected sheets.
Then simply loop the collection.
Select your desired sheets and run this:
Sub nameShts()
Dim i As Integer
i = 1
Dim sh As Worksheet
For Each sh In ThisWorkbook.Windows(1).SelectedSheets
sh.Name = "Week" & i
i = i + 1
Next sh
End Sub
It will only change the sheets selected
Worksheet.Next seems like a good fit for this problem
Sub nameShts()
Dim ws As Worksheet
Set ws = ActiveSheet
Do
ws.Name = "Test " & (ws.Index - ActiveSheet.Index + 1)
Set ws = ws.Next
Loop While Not ws Is Nothing
End Sub
Related
In VBA, I know it's possible to loop through worksheets like so:
for i = 1 to 5
msgbox worksheets(i).cells(1,1)
next
which pulls the first 5 sheets (in order from left to right) in the workbook. How can I reference the sheet's codenames instead? As in the first worksheet in the workbook might be Sheet10, the second Sheet6, etc...So if I'm trying to loop using sheet#s (codenames), is that possible?
You can create your own collection of worksheets that you can index by the code-name. This function does that:
Function SheetsByCodeName() As Collection
Dim sh As Worksheet
Set SheetsByCodeName = New Collection
For Each sh In ThisWorkbook.Worksheets
SheetsByCodeName.Add sh, sh.CodeName
Next
End Function
and then you can use it for your indexing, like so:
dim sheetsByCN as Object: Set sheetsByCN = SheetsByCodeName
dim cn
For each cn in Array("Sheet10","Sheet11","Sheet22","Sheet5","Sheet1")
debug.print sheetsByCN(cn).Cells(1,1).value
Next
The is no indexer on codeName so you have to loop through the sheets yourself.
A very basic example would be something like this:
Public Sub FindSheets()
Dim i As Integer
Dim objSheet As Worksheet
For i = 1 To 5
Set objSheet = FindSheetByName("Sheet" & i)
If objSheet Is Nothing Then
MsgBox "No sheet with codename Sheet" & i
Else
MsgBox objSheet.Name & " has codename " & objSheet.CodeName
End If
Next
End Sub
Function FindSheetByName(ByVal v_strCodeName As String) As Worksheet
Dim objSheet As Worksheet
Set FindSheetByName = Nothing
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.CodeName = v_strCodeName Then
Set FindSheetByName = objSheet
Exit Function
End If
Next
End Function
No, it's not possible to index sheets by their CodeName.
You can either loop all sheets and check their CodeName, or use a separate method:
Sub processSheet(ws As Worksheet)
Debug.Print ws.Cells(1)
End Sub
Sub process()
processSheet(Sheet10)
processSheet(Sheet11)
processSheet(Sheet12)
End Sub
Another alternative might be (not tested):
For Each ws In Array(Sheet10, Sheet11, Sheet12)
Debug.Print ws.Cells(1)
Next
If the sheets called Sht1, Sht2, ,, Sht5
Then
for i = 1 to 5
msgbox worksheets("Sht" & i).cells(1,1)
next
I need to cycle through sheets of index 3 tip last sheet and run a code. I tried something like this but its doesn't work.
If (ws.sheetIndex > 2) Then
With ws
'code goes here
End With
End If
I did a search but don't find a solution to this problem. Help would be much appreciated.
I also tried:
Dim i As Long, lr As Long
Dim ws As Worksheet
Windows("Book1").Activate
With ActiveWorkbook
Set ws = .Worksheets("index")
For i = 3 To 10
'code goes here
Next i
End With
You can try the following, which iterates over all worksheets in your workbook and only "acts" for worksheets with index 3 or above.
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Index > 2 Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(1, 1).Value = "hi"
End If
Next
Note that this doesn't put a hard limit on the number of sheets you have (10 or whatever), as it will work with any number of worksheets in your active workbook.
EDIT
If you want the code to run on worksheets with names "Sheet" + i (where i is an index number from 3 onwards), then the following should help:
Dim sheet As Worksheet
Dim i As Long
For i = 3 To ActiveWorkbook.Worksheets.Count
Set sheet = ActiveWorkbook.Worksheets(i)
If sheet.Name = "Sheet" & i Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(2, 2).Value = "hi"
End If
Next i
Of course, this means that the names of your worksheets need to always follow this pattern, so it's not best practice. However, if you're sure the names are going to stay like this, then it should work well for you.
Try excluding first and second sheet using name:
Public Sub Sheets3andUp()
Dim ws As Worksheet
Dim nameOfSheet1 As String
Dim nameOfSheet2 As String
nameOfSheet1 = "Sheet1"
nameOfSheet2 = "Sheet2"
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> nameOfSheet1 And ws.Name <> nameOfSheet2 Then
'Code goes here
Debug.Print ws.Name
End If
Next ws
End Sub
Note that the user can reorder the sheets in the Worksheets Collection, so it is better to refer to the sheets by CodeName (which the user cannot change), and exclude by CodeName the sheets to be skipped, as here:
Public Sub TestLoop()
On Error GoTo ErrHandler
Dim ws As Worksheet, s As String
For Each ws In Worksheets
If ws.CodeName <> "Sheet2" Then
s = s & vbNewLine & ws.CodeName
End If
Next ws
s = "WorksheetList (except Sheet2:" & vbNewLine & vbNewLine & s
MsgBox s, vbOKOnly, "Test"
EndSUb:
Exit Sub
ErrHandler:
Resume EndSUb
End Sub
If I drag Sheet 3 to precede Sheet1, the MsgBox outputs:
WorksheetList (except Sheet2:
Sheet3
Sheet1
I am trying to select a worksheet every time when i open up a workbook using an inputbox in VBA. here is my code for opening a workbook but after i open up my workbook, how do i select a worksheet inside that workbook?
Sub button7_click()
dim wb as string
dim ss as string
wb = Application.GetOpenFilename
if wb <> "False" Then Workbooks.Open wb
End sub
Assuming "Sheet1" is the name of the sheet that you want to select...
Workbooks(wb).Sheets("Sheet1").Select
EDIT: And you can use something like this to get a variable sheet name from an InputBox. In its simplest form...
Dim Result As String
Result = InputBox("Provide a sheet name.")
Workbooks(wb).Sheets(Result).Select
...but I would add some error handling into this also to prevent errors from blanks, misspelled or invalid sheet names.
Let's say you have a "normal", blank Excel workbook with sheets "Sheet1", "Sheet2" and "Sheet3". Now, when the workbook opens, let's assume you want to activate (not select, as that's different) the sheet called "Sheet2".
In your workbook's ThisWorkbook module, add this code:
Private Sub Workbook_Open()
ActiveWorkbook.Sheets("Sheet2").Activate
End Sub
Make sure this code is pasted inside of the ThisWorkbook object and not in a Module, Form, or Sheet object.
Save and exit the workbook. When you re-open it, "Sheet2" will be the active sheet.
Here is the final code if anyone wants it.
Multiple selections are not quite possible , as the copied worksheet only copies across and increments the largest value of the range selected rather than all the cells selected individually ....
Sub CopyAndIncrement()
Dim ws As Worksheet
Dim Count As Integer
Dim Rng As Range
Dim myValue As Integer
Dim wsName As String
wsName = InputBox("Provide the EXACT sheet name you want to copy.")
'error handling loop for Worksheet name
For p = 1 To Worksheets.Count
If Worksheets(p).Name = wsName Then
exists = True
End If
Next p
If Not exists Then
While exists = False
wsName = InputBox("Sheet not found re-enter name.")
For p = 1 To Worksheets.Count
If Worksheets(p).Name = wsName Then
exists = True
End If
Next p
Wend
End If
Set Rng = Application.InputBox( _
Title:="Increment your worksheet", _
Prompt:="Select a cell(s) you want to increment", _
Type:=8)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub 'Test to ensure User Did not cancel
'Set Rng = Rng.Cells(1, 1) 'Set Variable to first cell in user's input (ensuring only
'1 cell) >> commenting this can give multiple selections
myValue = InputBox("How many time do you want it to increment? Give me the number ")
Do While Count < myValue
For Each ws In Worksheets ' this loop selects the last sheet in the workbook
LastWs = ws.Name
i = ws.Range(Rng.Address).Value
If i > j Then
j = i
End If
Next
Sheets(wsName).Select
Sheets(wsName).Copy After:=Sheets(LastWs)
ActiveSheet.Range(Rng.Address).Value = j + 1
Count = Count + 1
Loop
End Sub
I have a code to List out all the open workbooks, since all my codes are in Personal.xlsb it also get listed, can anyone tell me an If condition to skip the Personal.xlsb from the list.
And also since Personal.xlsb dose not have a "Data_Index" it tends to give an error for that too
Sub ListWorkbooks()
Dim Wb As Workbook
For j = 1 To Workbooks.Count
Sheets("Data_Index").Select
Range("H3").Cells(j, 1) = Workbooks(j).Name
For i = 1 To Workbooks(j).Sheets.Count
Next i
Next j
End Sub
Sub ListWorkbooks()
Dim Wb As Workbook
Dim i As Integer, j As Integer
For j = 1 To Workbooks.Count
If Workbooks(j).Name <> ThisWorkbook.Name Then
Workbooks(j).Sheets("Data_Index").Range("H3").Cells(j, 1) = Workbooks(j).Name
End If
'not sure what you want to do here
For i = 1 To Workbooks(j).Sheets.Count
Next i
Next j
End Sub
Revised Answer
From reading your comments on other answers you need to also identify which of the open workbooks has a worksheet named Data_Index as well, which is why you were getting a subscript out of range (your code assumed that every workbook had a sheet named Data_Index.
This works for me when I test:
Sub ListWorkbooks()
Dim Wb As Workbook, wb2 As Workbook
Dim sht As Worksheet
Dim c As Range
'Identify which (if any) of the open workbooks has sheet Data_Index
'Note if more than one it will pick the last one it finds
On Error Resume Next
For j = 1 To Workbooks.Count
Set sht = Workbooks(j).Sheets("Data_Index")
Next j
On Error GoTo 0
'Check at least one has the required sheet
If sht Is Nothing Then
MsgBox "There is no open workbook with a sheet named Data_Index", vbExclamation
Else
'Set the destination for the first workbook name
Set c = sht.Range("H3")
For j = 1 To Workbooks.Count
If Workbooks(j).Name = "Personal.xlsb" Then GoTo NextWb
c.Value = Workbooks(j).Name
For i = 1 To Workbooks(j).Sheets.Count
' Whatever you want to do cycling sheets
Next i
'Offset to the next row ready for the next name
Set c = c.Offset(1, 0)
NextWb:
Next j
End If
End Sub
You could do this using arrays, but the above will do it for you.
I am trying to create a roadway design spreadsheet that can be used over and over again for hundreds of alignments. I got the everything working with a master sheet to be copied and two sheets used as lookup tables. I want to add two buttons in the corner that can be used to:
1) Copy the Master Sheet and rename it the alignmentname-##. This will be within the current workbook and will be used for each curve in the roadway alignment. It would be even better if there was a way to delete out these two buttons in the copied sheets.
2) A button to copy just the Master sheet, and two supplement sheets to a new workbook.
So far I have:
Sub Button10_Click()
Worksheets("Master (DO NOT MODIFY)").Copy _
Before:=ActiveWorkbook.Sheets("Master (DO NOT MODIFY)")
End Sub
It works fine for now just creating a copy of the base file, but I have not been able to rename it. The code for renaming the sheet is not working and I am not quite sure why.
Sheets(Count).Name = Range("H7").Value & "-" & Count
Where count is a public variable that goes up by one everytime a new curve is addedand H7 is the name of the alignment.
I have also played with the ActiveSheet. activesheet and Worksheets
Code for the first Button:
Public Count As Integer
Sub Button10_Click()
If Count = 0 Then
Count = 1
End If
Dim ws As Worksheet
Worksheets("Master (DO NOT MODIFY)").Copy _
Before:=ActiveWorkbook.Sheets("Master (DO NOT MODIFY)")
Set ws = ActiveSheet
ws.Name = Range("C2").Value & Count
Count = Count + 1
End Sub
Is this what you are trying? You cannot use count as the sheet is moved before the sheet and if you are incrementing the count then it will refer to the wrong sheet.
Sub Button10_Click()
Dim ws As Worksheet
Worksheets("Master (DO NOT MODIFY)").Copy _
Before:=ActiveWorkbook.Sheets("Master (DO NOT MODIFY)")
Set ws = ActiveSheet
ws.Name = Range("H7").Value & "-" & Count
End Sub
Regarding your 2nd question, you can try it like this. I am assuming that the master is not the last or the 2nd last sheet. Also there are two more sheets after the master.
Sub Button10_Click()
Dim ws As Worksheet
Dim wsMaster As Worksheet
Dim MyArray(1 To 3) As String
Dim n As Long
Set wsMaster = ThisWorkbook.Worksheets("Master (DO NOT MODIFY)")
wsMaster.Copy Before:=wsMaster
Set ws = ActiveSheet
ws.Name = Range("H7").Value & "-" & Count
n = ThisWorkbook.Sheets.Count
MyArray(1) = wsMaster.Name
MyArray(2) = ThisWorkbook.Sheets(n - 1).Name
MyArray(3) = ThisWorkbook.Sheets(n).Name
'~~> This will create a new workbook with the 3 sheets
ThisWorkbook.Sheets(MyArray).Copy
End Sub