Check sheet name and run the code related to the sheet - excel

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

Related

How to call another function within a function in VBA

I'm currently trying to detect duplicated sheet name using "CheckSheet" function. And I want to call this function to run in "Add Sheet" to prevent users from creating duplicate sheet names. However, I ran into error "Compile Error: Expected function or variable" and still not succeeding in solving the problem. Kindly enlighten me where I am doing it wrong and feel free to point out if there are any weakness and better optimization to my code. Thanks in advance.
Option Explicit
Public sheetName As Variant
Public cS As Variant
Sub CheckSheet(cS) 'To check duplicate sheet name - used in AddSheet function.
Dim wS As Worksheet
Dim wsName As String
wsName = wS(sheetName)
On Error GoTo 0
If wS Is Nothing Then
cS = False
Exit Sub
End Sub
Sub AddSheet()
Dim cSheet As Variant
cSheet = CheckSheet(cS).Value
On Error Resume Next
sheetName = Application.InputBox(prompt:="New Sheet Name", Left:=(Application.Width / 2), Top:=(Application.Height / 2), Title:="Add Sheet", Type:=2)
If sheetName = "" Then
MsgBox "Sheet name cannot be empty!"
Exit Sub
ElseIf cSheet = False Then
MsgBox "Duplicate Name! Please try again!"
Exit Sub
Else
Application.ScreenUpdating = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheetName
MsgBox """" & sheetName & """ was successfully created!"
Sheets("Sheet1").Activate
End If
End Sub
Two things.
1. Your code can be simplified. You do not need a function to check if a worksheet exists.
Option Explicit
Sub AddSheet()
Dim sh As Object
Dim sheetName As Variant
'~~> Accept user input
sheetName = Application.InputBox(prompt:="New Sheet Name", _
Left:=(Application.Width / 2), _
Top:=(Application.Height / 2), _
Title:="Add Sheet", Type:=2)
'~~> User presses cancel
If sheetName = False Then Exit Sub
'~~> Check if the sheet name is empty
If sheetName = "" Then
MsgBox "Sheet name cannot be empty!"
Exit Sub
End If
'~~> Check if the sheet exists
On Error Resume Next
Set sh = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0
If Not sh Is Nothing Then
MsgBox "Duplicate Name! Please try again!"
Exit Sub
End If
'~~> Create the worksheet
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = sheetName
MsgBox """" & sheetName & """ was successfully created!"
End With
End Sub
2. Even if you want to use a function, your code has lot of errors. (One of them is pointed out by #braX above.
Is this what you are trying?
Option Explicit
Sub AddSheet()
Dim sheetName As Variant
'~~> Accept user input
sheetName = Application.InputBox(prompt:="New Sheet Name", _
Left:=(Application.Width / 2), _
Top:=(Application.Height / 2), _
Title:="Add Sheet", Type:=2)
'~~> User presses cancel
If sheetName = False Then Exit Sub
'~~> Check if the sheet name is empty
If sheetName = "" Then
MsgBox "Sheet name cannot be empty!"
Exit Sub
End If
'~~> Check if the sheet exists
If DoesSheetExists(CStr(sheetName)) = True Then
MsgBox "Duplicate Name! Please try again!"
Exit Sub
End If
'~~> Create the worksheet
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = sheetName
MsgBox """" & sheetName & """ was successfully created!"
End With
End Sub
'~~> Function to check if sheet exists
Private Function DoesSheetExists(wsName As String) As Boolean
Dim sh As Object
'~~> Check if the sheet exists
On Error Resume Next
Set sh = ThisWorkbook.Sheets(wsName)
On Error GoTo 0
If Not sh Is Nothing Then DoesSheetExists = True
End Function

How do I modify this vba to copy column width and conditional formatting to an active sheet?

I am new to VBA.
Thank you for your time. I have been Googling for 2 days and always get an error.
I have two sheets
Projects ( where I will store project names) and
Template (where new projects will be created using the "template" sheet)
I have 2 issues I am trying to solve :
How do I copy the format on an active sheet including conditional formatting and column width. PasteSpecial already copies all the colour design but not the column width/conditional formatting
When I run the code it creates a new sheet called Project Name,not sure where that is coming from.
This is the code I am using:
Sub Copy()
Sheets("Template").Range("A1:O100").Copy
ActiveSheet.PasteSpecial
End Sub
<<<<<<<<<<<<<<<<<<<<<<
I want to generate a project name, make sure it does not exist(no duplicate), open a new sheet and copy the template from "template".
The full codes is:
RunAll()
CreateProjectName
CreateNewTab
CopyPaste
End Sub
Dim AddData As Range
Dim AddName As String
Set AddData = Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
AddName = InputBox("Enter Project Name do not input manually", "Project Monitor")
If AddName = "" Then Exit Sub
AddData.Value = AddName
AddData.Offset(0, 1).Value = Now
End Sub
Function SheetCheck(sheet_name As String) As Boolean
Dim ws As Worksheet
SheetCheck = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = sheet_name Then
SheetCheck = True
End If
Next
End Function
Sub CreateNewTab()
Dim sheets_count As Integer
Dim sheet_name As String
Dim i As Integer
sheet_count = Range("D3:D1000").Rows.Count
For i = 1 To sheet_count
sheet_name = Sheets("Projects").Range("D3:D1000").Cells(i, 1).Value
If SheetCheck(sheet_name) = False And sheet_name <> "" Then
Worksheets.Add(After:=Sheets("Projects")).Name = sheet_name
End If
Next i
End Sub
Sub CopyPaste()
Sheets("Template").Range("A1:o100").Copy
ActiveSheet.PasteSpecial
End Sub
Option Explicit
Sub AddProject()
Dim ws As Worksheet, NewName As String
NewName = InputBox("Enter Project Name do not input manually", "Project Monitor")
' checks
If NewName = "" Then
MsgBox "No name entered", vbCritical
Exit Sub
Else
' check sheet not existing
For Each ws In ThisWorkbook.Sheets
If UCase(ws.Name) = UCase(NewName) Then
MsgBox "Existing Sheet '" & ws.Name & "'", vbCritical, "Sheet " & ws.Index
Exit Sub
End If
Next
End If
' check not existing in list
Dim wb As Workbook, n As Long, lastrow As Long, v
Set wb = ThisWorkbook
With wb.Sheets("Projects")
lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row
v = Application.Match(NewName, .Range("D1:D" & lastrow), 0)
' not existing add to list
If IsError(v) Then
.Cells(lastrow + 1, "D") = NewName
.Cells(lastrow + 1, "E") = Now
Else
MsgBox "Existing Name '" & NewName & "'", vbCritical, "Row " & v
Exit Sub
End If
End With
' create sheet
n = wb.Sheets.Count
wb.Sheets("Template").Copy after:=wb.Sheets(n)
wb.Sheets(n + 1).Name = NewName
MsgBox NewName & " added as Sheet " & n + 1, vbInformation
End Sub

Loop through all sheets and look for value in range. If found then do some action and GoTo

I have quite simple piece of code below. I need it to loop through all sheets in workbook and look for particular value in range. If found then perform some actions (Get sheet name and store in temporary sheet) and go to another lines to complete rest of the code.
Only one worksheet will contain this value or none. So if this value wont be find in any of those worksheets I want to run code from Step2. Workbook can contain even 20-30 sheets.
If i run this code with Else disabled it works fine. It finds sheet, complete If and performs rest of the code
However if value not found in any of sheets I would like to GoTo Step 2 to other sub. But whenever I have this Else: GoTo Step2: enabled it goes to Step2: just after checking first sheet withouth searched value.
Any idea what I am doing wrong. It is simple piece of code and I am getting crazy with it :)
Sub ProjectGCA1 ()
Application.ScreenUpdating = False
Dim ws, shGCA1 As Worksheet
Dim wb As Workbook
Dim i, j As Long
Set wb = ThisWorkbook
wb.Sheets.Add.Name = "Temporary storage"
j = wb.Sheets.Count
For i = 1 To j
If wb.Sheets(i).Range("A4") = "Project Name: GCA1" Then
Set shGCA1 = wb.Sheets(i)
wb.Sheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
wb.Sheets("Temporary storage").Range("B1").Value = wb.Sheets(i).Name
'Else: GoTo Step2:
End If
Next i
Step1:
' -----------------------rest of the code to work on shGCA1------------------------
' -----------------------rest of the code to work on shGCA1------------------------
Step2
Call ProjectGCA2
End Sub
If you activate the else within the loop, of course the loop will be left at the first iteration. You need to check after the loop was finished if the sheet was found.
As far as I understand, you are setting shGCA1 to the sheet you found, so you can check if it was set or not. If you don't have such a variable, just create a boolean variable and set it to True if something was found. Important is that you check it after the loop was done.
For i = 1 To j
If wb.Sheets(i).Range("A4") = "Project Name: GCA1" Then
Set shGCA1 = wb.Sheets(i)
wb.Sheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
wb.Sheets("Temporary storage").Range("B1").Value = wb.Sheets(i).Name
' If you are sure there is at most one sheet, you can leave the loop now:
Exit For
End If
Next i
If Not shGCA1 Is Nothing then
' Do your stuff with the sheet.
Else
' Do the stuff if no sheet was found
End If
If the behavior of the program is not clear, I strongly advise to use the debugger and step thru the code line by line (using F8)
Reference Worksheet With String In Cell
You could use the following function to reference the found worksheet:
Function RefWorksheetWithStringInCell( _
ByVal wb As Workbook, _
ByVal CellAddress As String, _
ByVal CellString As String, _
Optional ByVal MatchCase As Boolean = False) _
As Worksheet
Const ProcName As String = "RefWorksheetWithStringInCell"
On Error GoTo ClearError
Dim CompareMethod As VbCompareMethod
CompareMethod = IIf(MatchCase = False, vbTextCompare, vbBinaryCompare)
Dim ws As Worksheet
For Each ws In wb.Worksheets
If StrComp(CStr(ws.Range(CellAddress).Value), CellString, _
CompareMethod) > 0 Then
Set RefWorksheetWithStringInCell = ws
Exit For
End If
Next ws
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Function
Then you could rewrite your code in the following way:
' Now the loop is in the function.
Set shGCA1 = RefWorksheetWithStringInCell(wb, "A4", "Project Name: GCA1")
If shGCA1 Is Nothing Then ' not found
ProjectGCA2 ' 'Call' is considered deprecated
Exit Sub
Endif
wb.Worksheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
wb.Worksheets("Temporary storage").Range("B1").Value = shGCA1.Name
' Continue...
Here's a function that would give you control over adding a worksheet, e.g. in case it already exists:
Function RefAddedWorksheet( _
ByVal wb As Workbook, _
ByVal WorksheetName As String, _
Optional ByVal DoKeepExisting As Boolean = False) _
As Worksheet
Const ProcName As String = "RefAddedWorksheet"
On Error GoTo ClearError ' e.g. invalid sheet name
Dim sh As Object ' e.g. chart
Dim DoesWorksheetExist As Boolean
On Error Resume Next
Set sh = wb.Sheets(WorksheetName)
On Error GoTo ClearError
If Not sh Is Nothing Then ' sheet already exists
If sh.Type = xlWorksheet Then ' is worksheet
If DoKeepExisting Then ' keep
DoesWorksheetExist = True ' flag it existing
'Else ' don't keep
End If
'Else ' is chart
End If
If Not DoesWorksheetExist Then ' not flagged existing
Application.DisplayAlerts = False ' delete without confirmation
sh.Delete
Application.DisplayAlerts = True
'Else ' flagged existing
End If
'Else ' sheet doesn't exist
End If
If Not DoesWorksheetExist Then ' not flagged existing
Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
On Error Resume Next
sh.Name = WorksheetName
On Error GoTo ClearError
'Else ' flagged existing
End If
If StrComp(sh.Name, WorksheetName, vbTextCompare) = 0 Then ' valid name
Set RefAddedWorksheet = sh
Else ' invalid name
Application.DisplayAlerts = False ' delete without confirmation
sh.Delete
Application.DisplayAlerts = True
End If
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Function
In your code, you could e.g. use it in the following way:
Const wsTempName As String = "Temporary storage"
Const wsTempDoKeepExisting As Boolean = False
Dim wsTemp As Worksheet
Set wsTemp = RefAddedWorksheet(wb, wsTempName, wsTempDoKeepExisting)
If wsTemp Is Nothing Then ' highly unlikely (if invalid name e.g. 'History')
MsgBox "Could not create the '" & wsTempName & "' worksheet.", _
vbCritical
Exit Sub
End If
Note that the function adds the worksheet after the last sheet in the workbook.

How to jump to worksheet by typing partial name

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

Excel rename sheet with if sheet name already exists

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.

Resources