I am trying to write a code that loop through to hide worksheet tab automatically if certain name exists then add column with vlookup. If none of this names exists do nothing. if I didn't manually comment the . I am trying to hide if it exist (Michael , Jami , Stam, Christina) if they exist I want to hide them if none of those names exist do nothing in the code, It is giving me an error.
Sub Admin_Auto_Add()
Dim rec_range As String
Dim wb As Workbook
Dim lookup_reference As String
With Original
ActiveWorkbook.Sheets("Michael").Visible = xlSheetHidden
ActiveWorkbook.Sheets("Jami").Visible = xlSheetHidden
' ActiveWorkbook.Sheets("Stam").Visible = xlSheetHidden
ActiveWorkbook.Sheets("Christina").Visible = xlSheetHidden
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Value = "Admin_Vlookup"
rec_range = getColRangeFunction("Admin_Vlookup")
Range(rec_range).Formula = "=VLOOKUP(B2,'[Pairing List.xlsx]Recruiting_Admins'!$A$1:$B$32, 2,0)"
Range(rec_range).Select
End With
End Sub
Perhaps something like this then.
Sub HideSheets()
Dim ws As Worksheet
Dim arrNames As Variant
Dim Res As Variant
' add/remove/change names of sheets you want to hide here
arrNames = Array("Michael", "Jami", "Stam", "Christina")
For Each ws In ActiveWorkbook.Sheets
Res = Application.Match(ws.Name, arrNames, 0)
If Not IsError(Res) Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
Related
I have a multitude of sheets in my workbook. I want to hide some of them. The primary criterion can be hiding them beyond the sheet with some specified name.
In my case, this is the sheet named BoM
I want everything to be hidden behind this worksheet.
What I tried is:
Sub Sheethidden()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name > "BoM" Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
but it didn't work
Please, try the next way. You need to use the sheet Index as reference:
Sub Sheethidden()
Dim wsIndex As Long, i As Long
wsIndex = Worksheets("BoM").Index
For i = wsIndex + 1 To Worksheets.count
Worksheets(i).Visible = xlSheetHidden
Next i
End Sub
or you may keep your code and compare the sheets index:
Sub Sheethidden()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.index > Worksheets("BoM").Index Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
Adapting your code, I would do as follow.
Public Sub HideSheetAfterName()
Const NAME_SHEET = "BoM"
Dim ws As Worksheet
Dim ws_pass As Boolean
ws_pass = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = NAME_SHEET Then ws_pass = True
If ws_pass Then ws.Visible = xlSheetHidden
Next ws
End Sub
Since you know Excel worksheets in ThisWorkbook.Worksheets are ordered by order they appear in the Excel workbook, I suggest just to check when you find the desired NAME_SHEET.
Additional suggestion: always use ThisWorkbook before Worksheet object in order to force using the current workbook.
I have put together the code below to hide named worksheets using a Checkbox. The workbook also contains sheets with the generic names like Sheet1, Sheet2, etc and I would like to be able to hide all sheets whose name contains the word "Sheet" from the same Checkbox.
Is this possible?
Thanks
Private Sub CheckBox1_Click()
Application.ScreenUpdating = False
If CheckBox1 = False Then
If ThisWorkbook.Sheets("Summary").Range("B10") <> "" Then Sheets(ActiveSheet.Range("B10").Value).Visible = False
Else:
If ThisWorkbook.Sheets("Summary").Range("B10") <> "" Then Sheets(ActiveSheet.Range("B10").Value).Visible = True
End If
Application.ScreenUpdating = False
End Sub
If you really want hiding sheets, please use the next code. It hides all sheets where their name starts with ""Sheet":
Private Sub CheckBox1_Click()
Dim sh As Worksheet
For Each sh In Worksheets
If left(sh.name, 5) = "Sheet" Then
sh.Visible = xlSheetVeryHidden
End If
Next
End Sub
Hide Worksheet With Pattern
Reminder
At least one of all sheets in a workbook has to be visible.
There is a third 'visibility' parameter xlSheetHidden which is not considered in this solution.
You can hide multiple worksheets in one go by using an array of worksheet names (fast), but you have to loop through the array to unhide each of them (slow).
The Code
Option Explicit
Private Sub CheckBox1_Click()
Const WorksheetPattern As String = "ShEeT*"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsArr As Variant
Application.ScreenUpdating = False
If CheckBox1 Then ' Hide
wsArr = WorksheetNamesToArray(wb, WorksheetPattern)
wb.Worksheets(wsArr).Visible = xlSheetHidden ' also 0 or False
Else ' UnHide
wsArr = WorksheetNamesToArray(wb, WorksheetPattern, xlSheetHidden)
Dim n As Long
For n = 1 To UBound(wsArr)
wb.Worksheets(wsArr(n)).Visible = xlSheetVisible ' also -1 or True
Next n
End If
Application.ScreenUpdating = True
End Sub
Function WorksheetNamesToArray( _
ByVal wb As Workbook, _
ByVal WorksheetPattern As String, _
Optional ByVal isVisible As XlSheetVisibility = xlSheetVisible) _
As Variant
If Not wb Is Nothing Then
Dim wsCount As Long: wsCount = wb.Worksheets.Count
Dim wsArr() As String: ReDim wsArr(1 To wsCount)
Dim ws As Worksheet
Dim n As Long
For Each ws In wb.Worksheets
If UCase(ws.Name) Like UCase(WorksheetPattern) Then
If ws.Visible = isVisible Then
n = n + 1
wsArr(n) = ws.Name
End If
End If
Next ws
ReDim Preserve wsArr(1 To n)
WorksheetNamesToArray = wsArr
End If
End Function
I have tried to make this code but still having an issue.
Question is simple -
If sheet2 exists then
ThisWorkbook.Sheets(Sheet1).Range(a1).Select
If does not exist then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1")) ws.Name = "Sheet2"
But after adding sheet2 it still gives error.
Below is the code:
Sub new6()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If ws.Name <> "Sheet2" Then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
Else
ThisWorkbook.Sheets(Sheet1).Range(a1).Select
End If
Next
End Sub
I think you need to change your approach and remove that loop entirely by implementing a great solution from #Tim Williams. The issue with your code is you are adding a new sheet before verifying if the sheet exists in the book.
Add the WorksheetExists function which will scan the entire workbook for a sheet without a loop and return WorksheetExists = TRUE or FALSE. From there you can simplify your macro by removing the loop and acting on the result of the function.
You can also avoid Select here with Application.Goto
Sub new6()
Dim ws As Worksheet
If WorksheetExists("Sheet2", ActiveWorkbook) Then
Application.Goto (Sheets("Sheet1").Range("A1"))
Else
Set ws = Worksheets.Add(After:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
End If
End Sub
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function
Before selecting the A1 range with ThisWorkbook.Sheets(Sheet1).Range(a1).Select, the correct sheet should be selected on the line before.
The second error is that Sheets collection expects a string. Thus:
ThisWorkbook.Sheets("Sheet1").Select
ThisWorkbook.Sheets("Sheet1").Range("a1").Select
For the code above, put a boolean variable, which tracks whether Sheet2 was found. If it was not found, then create a new Worksheet:
Sub new6()
Dim wb As Workbook
Dim ws As Worksheet
dim isFound As Boolean
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If ws.Name <> "Sheet2" Then
'Do Nothing
Else
isFound = True
ThisWorkbook.Sheets("Sheet1").Select
ThisWorkbook.Sheets("Sheet1").Range("a1").Select
End If
Next
If Not isFound Then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
End If
End Sub
The code above will throw an error, if "Sheet1" does not exist. But you may try to make sure that it exists with a few additional lines.
In general - try to avoid Select - How to avoid using Select in Excel VBA.
And whenever having queries about Selecting cells in VBA, use the Macro Recorder, for the first couple of months its help will be useful.
I have an action log where users can select meeting name, user name, etc through a userform with comboboxes. I have also created a button where users can add a new meeting to the combo box list.
Currently I have a vba code that will check the value of a cell on sheet173 (data entered from userform), create a new sheet named with the cell value and copy the data from sheet173 into the new sheet. The problem I have is that if an action is added and there is already a sheet created for this, I need the data to be added to the next row of that sheet.
I have got the code working up until the point where the sheet is already created but additional rows need to be added. I know the exit sub needs to come out but i'm not sure what to replace it with.
Sub copy_newsheet()
Dim pname
Dim ws As Worksheet
pname = Sheets("Sheet173").Range("A1").Value
For Each ws In ActiveWorkbook.Sheets
If ws.Name = pname Then
Exit Sub
End If
Next ws
Sheets("Sheet173").Range("A1:E1").Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
ActiveSheet.Name = pname
End Sub
This should do it:
Option Explicit
Sub Test()
Dim pname As String
'full quallify your ranges, include the workbook
pname = ThisWorkbook.Sheets("Sheet173").Range("A1").Value 'thisworkbook means the workbook which contains the code
'with this variable we can know if the worksheet exists or not
Dim SheetExists As Boolean
SheetExists = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = pname Then SheetExists = True
Next ws
'check if it doesn't exist
If Not SheetExists Then
'if it doesn't exist, then create the worksheet and give it the name from pname
With ThisWorkbook
.Sheets.Add After:=.Sheets(.Sheets.Count)
.Sheets(.Sheets.Count).Name = pname
End With
End If
'with this variable we can find the last row
Dim LastRow As Long
With ThisWorkbook.Sheets(pname)
'calculate the last row on the pname sheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'equal the value from the pname sheet Range A:E to the sheet173 range A1:E1
.Range(.Cells(LastRow, "A"), .Cells(LastRow, "E")).Value = ThisWorkbook.Sheets("Sheet173").Range("A1:E1").Value
End With
End Sub
You are already pretty close, try this code:
Sub smth()
Dim pname As String
Dim ws As Worksheet, sh As Worksheet
pname = Sheets("Sheet173").Range("A1").Value
For Each sh In ActiveWorkbook.Sheets
If sh.Name = pname Then
Set ws = sh
GoTo Found
End If
Next sh
Set ws = Sheets.Add(After:=ActiveSheet)
ws.Name = pname
Found:
Sheets("Sheet173").Range("A1:E1").Copy
ws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End Sub
To explain: If the For loop finds a sheet with the specified namen it will set ws as that sheet and jump to Found:, where the actual copying and pasting happens. If the For loop doesn't find anything it will set ws as a new sheet.
Please note that ActiveWorkbook and ActiveSheet can be prone to causing unwanted errors.
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