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
Related
I' am looking for a code to check Sheet names initially like A, B, C. If sheet A exist then it should run the code which is goto A1: else it should go to B and check if Sheet B exist, if sheet B exist then it should run code below B1, Same way for sheet C as well.
Ex:
For I = 1 to worksheets.count
If Sheets(i).Name = "A" Then
GoTo A1
Else
GoTo B
End If
Next I
I think it can be solved by using ElseIf or Select Case.
Please try with the following 2 cases.
Dim i As Integer
For i = 1 To Worksheets.Count
Select Case Sheets(i).Name
Case "A"
' Coding for "GoTo A1"
Case "B"
' Coding for "GoTo B1"
Case "C"
' Coding for "GoTo C1"
...
End Select
Next i
Or
Dim i As Integer
For i = 1 To Worksheets.Count
If Sheets(i).Name = "A" Then
' Coding for "GoTo A1"
ElseIf Sheets(i).Name = "B" Then
' Coding for "GoTo B1"
ElseIf Sheets(i).Name = "C" Then
' Coding for "GoTo C1"
Else
...
End If
Next i
If you have a specific macro you want to run on each sheet and you want to trigger all of them to run at once, you can organize it like so:
Sub Main()
Call SheetA_Macro
Call SheetB_Macro
Call SheetC_Macro
End Sub
If you have a lot of sheets you can automate the calling of these macros by naming them all the same thing and placing them into the sheet's code module, which would let you call them in this way:
Sub Main()
Dim Sht As Worksheet
For Each Sht In ThisWorkbook.Worksheets
Call ThisWorkbook.Sheets(Sht.Name).MySheetSpecificMacro
Next Sht
End Sub
If you have an unknown sheet and you want to call only that specific sheets macro, then you will want to do it like above but without the loop.
Call ThisWorkbook.Sheets(MyUnknownSheetObject.Name).MySheetSpecificMacro
Remember that the macros must be placed into the sheet's code module and should all be named the same thing.
Worksheet Related Code
Writes the list of worksheet names to an array.
Loops through the array attempting to find an existing worksheet using the WorksheetExists function.
Continues with the worksheet that exists (if any).
Option Explicit
Sub ApplyToFirstFound()
Const wsNamesList As String = "A,B,C"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim wsNames() As String: wsNames = Split(wsNamesList, ",")
Dim wsName As String
Dim n As Long
For n = 0 To UBound(wsNames)
If WorksheetExists(wb, wsNames(n)) Then
wsName = wsNames(n)
Exit For
End If
Next n
' You could continue with...
If n > UBound(wsNames) Then
MsgBox "No worksheet exists.", vbCritical, "ApplyToFirstFound"
Exit Sub
End If
MsgBox "The first found worksheet is named '" & wsName & "'.", _
vbInformation, "ApplyToFirstFound"
' ... continue...
' ... or with a different code for each worksheet (I've used the same.).
Select Case wsName
Case "A"
MsgBox "Applying to '" & wsName & "'.", _
vbInformation, "ApplyToFirstFound"
Case "B"
MsgBox "Applying to '" & wsName & "'.", _
vbInformation, "ApplyToFirstFound"
Case "C"
MsgBox "Applying to '" & wsName & "'.", _
vbInformation, "ApplyToFirstFound"
Case Else
MsgBox "No worksheet exists.", vbCritical, "ApplyToFirstFound"
End Select
End Sub
Function WorksheetExists( _
ByVal wb As Workbook, _
ByVal WorksheetName As String) _
As Boolean
On Error GoTo ClearError
Dim ws As Worksheet: Set ws = wb.Worksheets(WorksheetName)
WorksheetExists = Not ws Is Nothing
Exit Function
ClearError:
Resume Next
End Function
I am working with an EXCEL file with 11 worksheets, in this configuration:
VOL_CODE = The code that I look for. If present in a worksheet, the entire line containing VOL_CODE should be deleted.
Worksheets:
“NEW VOL DATA” –This is the worksheet that “stays on” (‘Active’ or ‘Selected’) during the whole process.
Also, here are in range K1:K10 the indications (“X”) if the destination worksheets are selected or not.
“DESTINATION1”, “DESTINATION2”, “DESTINATION3” ... “DESTINATION10”
“Target” worksheets where if VOL_CODE appears AND worksheet is indicated as ‘selected’ (in “NEW VOL DATA” worksheet), it’s line should be removed.
Code:
Private Sub CommandButton3_Click()
'--- Remove VOL_CODE line from all worksheets -----
Dim ws1, ws2 As Worksheet
Dim VOL_CODE As String
Dim PLA, LIN As Integer
Set ws1 = Worksheets("NEW VOL DATA") '--- This is the Working Worksheet -----
VOL_CODE = “RS_123456” ‘--- This is the code to search for -----
For PLA = 1 To 10
If UCase(Range("K" & PLA)) <> "X" Then GoTo JUMP_PLA:
Set ws2 = Worksheets("DESTINATION" & Trim(Str(PLA)))
Do While True
On Error GoTo JUMP_PLA:
LIN = Application.WorksheetFunction.Match(VOL_CODE, ws2.Range("B:B"), 0)
ws2.Cells(LIN, 1).EntireRow.Delete
Loop
JUMP_PLA:
Next PLA
End Sub
The problem is, when I execute the code, it goes fine in DESTINATION1 worksheet, containing or not VOL_CODE (if it does, it loops deleting VOL_CODE’s lines until there are no more), then, when finding no more entries for VOL_CODE, it goes to “JUMP_PLA:” and “Next PLA”... There it starts over, now going to next “DESTINATIONx” worksheet (the next selected)... And there’s an error (finding or not a valid entry) when the Application.WorksheetFunction.Match command executes :
Error in execution: 1004
Application definition or Object definition error
I know it must be a stupid error, but as I am a newbie, I cannot visualize it. And it is driving me crazy...
Can anyone give me a light? It would be very appreciated, and I thank you in advance.
Application.WorksheetFunction.Match to Delete Rows
The procedure doDest is best copied into a standard module (e.g. Module1) and then called in your button code:
Private Sub CommandButton3_Click()
doDest
End Sub
I left your code inside it, so you could see the mistakes and some options.
The rest of the code is just some toys a created to play with, since I've never seen Match used for deleting rows.
IF you wanna play, copy the complete code into a standard module in a new workbook and rename a worksheet to NEW VOL DATA. In range K1:K10 of it, enter an x in a few cells and you're good to go.
The Code
Option Explicit
Sub doDest()
'--- Remove VOL_CODE line from all worksheets -----
' Speed up the code (you won't see what the macro is doing).
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet 'Dim ws1, ws2 As Worksheet
Dim VOL_CODE As String
Dim PLA As Long, LIN As Long ' Dim PLA, LIN As Integer
Dim wb As Workbook: Set wb = ThisWorkbook ' The workbook with this code.
Set ws1 = wb.Worksheets("NEW VOL DATA") 'Set ws1 = Worksheets("NEW VOL DATA") '--- This is the Working Worksheet -----
VOL_CODE = "RS_123456" '--- This is the code to search for -----
For PLA = 1 To 10
'If StrComp(ws1.Range("K" & PLA).Value, "X", vbTextCompare) <> 0 _
Then GoTo JUMP_PLA
If UCase(ws1.Range("K" & PLA).Value) <> "X" Then GoTo JUMP_PLA ' If UCase(Range("K" & PLA)) <> "X" Then GoTo JUMP_PLA:
Set ws2 = wb.Worksheets("DESTINATION" & PLA) ' Set ws2 = Worksheets("DESTINATION" & Trim(Str(PLA)))
Do ' Do While True
' On Error GoTo JUMP_PLA:
' LIN = Application.WorksheetFunction.Match(VOL_CODE, ws2.Range("B:B"), 0)
' ws2.Cells(LIN, 1).EntireRow.Delete
On Error Resume Next ' Turn ON error trapping.
' "ws2.Columns("B")" is just an option, you can stick with
' "ws2.Range("B:B")".
LIN = Application.WorksheetFunction _
.Match(VOL_CODE, ws2.Columns("B"), 0)
If Err.Number <> 0 Then
On Error GoTo 0 ' Turn OFF error trapping.
'Debug.Print "Done with worksheet '" & ws2.Name & "'."
Exit Do ' or: GoTo JUMP_PLA
Else
On Error GoTo 0 ' Turn OFF error trapping.
ws2.Cells(LIN, 1).EntireRow.Delete
End If
Loop
JUMP_PLA:
Next PLA
Application.ScreenUpdating = True
MsgBox "Deleted rows containing '" & VOL_CODE & "'.", _
vbInformation, "Success"
End Sub
' Deletes all sheets named "DESTINATIONx", where x is from 1 to 10.
Sub deleteDest()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim i As Long
For i = 1 To 10
Application.DisplayAlerts = False ' To prevent Excel from 'complaining'.
On Error Resume Next ' If a sheet does not exist.
wb.Sheets("DESTINATION" & i).Delete
On Error GoTo 0
Application.DisplayAlerts = True
Next i
End Sub
' Adds worksheets named "DESTINATIONx", where x is from 1 to 10.
' In each of those worksheets, adds "RS_123456" to up to 100 cells
' in 'random' rows from 1 to 1000 in column 'B'.
Sub createDest()
' Speed up the code (you won't see what the macro is doing).
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet, i As Long, j As Long, CurrName As String
For i = 1 To 10
CurrName = "DESTINATION" & i
On Error Resume Next ' Turn ON error trapping.
Set ws = wb.Worksheets(CurrName)
If Err.Number <> 0 Then
' Sheet with current name does not exist.
Set ws = wb.Worksheets _
.Add(After:=wb.Worksheets(wb.Worksheets.Count))
ws.Name = CurrName
'Else ' Sheet with current name exists.
End If
On Error GoTo 0 ' Turn OFF error trapping.
ws.Columns("B").Clear ' Ensures new data if sheets already exist.
For j = 1 To 100
ws.Cells(Application.WorksheetFunction.RandBetween(1, 1000), "B") _
.Value = "RS_123456"
Next j
Next i
wb.Sheets(1).Select
Application.ScreenUpdating = True
End Sub
' Counts the number of cells in column 'B' containing a value.
Sub countDest()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim i As Long
For i = 1 To 10
On Error Resume Next
Debug.Print "DESTINATION" & i, wb.Worksheets("DESTINATION" & i) _
.Columns("B") _
.SpecialCells(xlCellTypeConstants) _
.Cells.Count
If Err.Number <> 0 Then
Debug.Print "DESTINATION" & i, "No cells found."
End If
Next i
End Sub
' Ultimate test
Sub testDest()
deleteDest ' Deletes the sheets.
createDest ' Creates the worksheets with random data.
countDest ' Counts the cells containing "RS_123456" (Debug.Print).
doDest ' Deletes the rows containing "RS_123456" in column 'B'.
countDest ' Counts the cells containing "RS_123456" (Debug.Print).
MsgBox "Ultimate: deleted, created, counted, done and counted again."
End Sub
' Initialize
Sub initCreateAndCount()
deleteDest ' Deletes the sheets.
createDest ' Creates the worksheets with random data.
countDest ' Counts the cells containing "RS_123456" (Debug.Print).
MsgBox "Initialized: Sheets deleted and created, and cells counted."
End Sub
' Shows how even when the 'dest' sheets exist, new values are generated.
Sub testCreateCount()
createDest ' Creates the worksheets with random data.
countDest ' Counts the cells containing "RS_123456" (Debug.Print).
MsgBox "Sheets created and cells counted."
End Sub
Here's a slightly re-worked version.
See comments for notes about changes
Private Sub CommandButton3_Click()
Dim ws1 As Worksheet, ws2 As Worksheet '<< need type for every variable,
' not just the last one...
Dim VOL_CODE As String
Dim PLA As Long, LIN As Long, m '<< use Long, not Integer
Set ws1 = Worksheets("NEW VOL DATA") 'Working Worksheet
VOL_CODE = "RS_123456" '<<< no smart quotes...
For PLA = 1 To 10
If UCase(ws1.Range("K" & PLA)) = "X" Then
Set ws2 = Worksheets("DESTINATION" & PLA)
m = Application.Match(VOL_CODE, ws2.Range("B:B"), 0)
Do While Not IsError(m) '<<< Test return value instead of
' trapping run-time error
ws2.Rows(m).Delete
m = Application.Match(VOL_CODE, ws2.Range("B:B"), 0)
Loop
End If
Next PLA
End Sub
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
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 need to pull a sheet's position in a workbook knowing only it's name -- so for instance:
if we have a sheet, say
Workbook.Sheets("Sheet2")
how would I find the corresponding integer so that I could refer to it as:
say i is an integer
Workbook.Sheets(i)
I need to be able to do this reverse indicing so I can refer to sheets next to the sheet I'm referencing.
Thank you for your help.
Workbook.Sheets("sheet name").Index
Edit: brettdj's answer inspired me, so I wrote this function which could probably be cleaned up infact thinking about it, if I were actually going to use and support this I would probably make a find sheet function instead of what the sub does if you say true for the 4th parameter:
Function adjacentsheet(Optional ws As Worksheet, Optional wsName As String, Optional nextSheet As Boolean = True, Optional search As Boolean = False) As Worksheet
'Expects worksheet or worksheet.name if blank, uses activesheet.
'Third parameter indicates if the next sheet or previous sheet is wanted, default is next = true
'Indicates adjacent sheet based on worksheet provided.
'If worksheet is not provided, uses worksheet.name.
'If no worksheet matches corresponding name, checks other workbooks if 4th parameter is true
'If no worksheet can be found, alerts the user.
'Returns found worksheet based upon criteria.
If (ws Is Nothing) Then
If wsName = "" Then
Set adjacentsheet = adjacentsheet(ActiveSheet, , nextSheet)
Else
'Check all workbooks for the wsName, starting with activeWorkbook
On Error Resume Next
Set ws = Sheets(wsName)
On Error GoTo 0
If (ws Is Nothing) Then
If search = True Then
If Workbooks.Count = 1 Then
GoTo notFound
Else
Dim wb As Workbook
For Each wb In Application.Workbooks
On Error Resume Next
Set ws = wb.Sheets(wsName)
On Error GoTo 0
If Not (ws Is Nothing) Then
Set adjacentsheet = adjacentsheet(ws, , nextSheet)
Exit For
End If
Next
If (ws Is Nothing) Then GoTo notFound
End If
Else
GoTo notFound
End If
Else
Set adjacentsheet = adjacentsheet(ws, , nextSheet, search)
End If
End If
Else
With ws.Parent
If nextSheet Then
If ws.Index = .Sheets.Count Then
Set adjacentsheet = .Sheets(1)
Else
Set adjacentsheet = .Sheets(ws.Index + 1)
End If
Else
If ws.Index = 1 Then
Set adjacentsheet = .Sheets(.Sheets.Count)
Else
Set adjacentsheet = .Sheets(ws.Index - 1)
End If
End If
End With
End If
Exit Function
notFound:
MsgBox "Worksheet name could not be found!", vbCritical, "Invalid worksheet name."
End Function
Here are some usage examples:
'Usage Examples
Dim nextws As Worksheet
'returns sheet before the active sheet
Set nextws = adjacentsheet(, , False)
'returns sheet after the active sehet
Set nextws = adjacentsheet()
'returns sheet after sheet named "Test" in current workbook
Set nextws = adjacentsheet(, "Test")
'returns sheet after sheet named "Test" in any open workbook checking current workbook first
Set nextws = adjacentsheet(, "Test", , True)
If you want to refer to the Next or Previous sheet then you can do this without incrementing the starting sheet position
Sub Test()
If Sheets.Count > ActiveSheet.Index Then
Debug.Print "next method: " & ActiveSheet.Next.Name
Debug.Print "index method: " & Sheets(ActiveSheet.Index + 1).Name
Else
Debug.Print "Active Sheet is the last sheet"
End If
End Sub