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
Related
Wondering why I can't do :
For i = 1 To ThisWorkbook.Sheets.Count
If ThisWorkbook.Sheets(i).Name <> "DO NOT SAVE" Then ThisWorkbook.Sheets(i).Select Replace:=False
Next i
Selection.Copy
what would be the best way to save all sheets which does not match DO NOT SAVE name in another wb ?
Try this:
Sub Tester()
Dim ws As Worksheet, arr(), i As Long
ReDim arr(0 To ThisWorkbook.Worksheets.Count - 2)
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "DO NOT SAVE" Then
arr(i) = ws.Name
i = i + 1
End If
Next ws
Worksheets(arr).Copy
End Sub
A Reflection on the Sheets' Visibility
To export a single sheet to a new workbook, the sheet has to be visible.
To export multiple sheets (using an array of sheet names) to a new workbook, at least one of the sheets has to be visible, while very hidden sheets will not get exported (no error though).
In a given workbook, the following procedure will copy all its sheets, except the ones whose names are in a given array (Exceptions), to a new workbook if at least one of the sheets is visible.
Before copying, it will 'convert' the very hidden sheets to hidden and after the copying, it will 'convert' the originals and copies to very hidden.
Option Explicit
Sub ExportSheets( _
ByVal wb As Workbook, _
ByVal Exceptions As Variant)
Dim shCount As Long: shCount = wb.Sheets.Count
Dim SheetNames() As String: ReDim SheetNames(1 To shCount)
Dim sh As Object
Dim coll As Object
Dim Item As Variant
Dim n As Long
Dim VisibleFound As Boolean
Dim VeryHiddenFound As Boolean
For Each sh In wb.Sheets
If IsError(Application.Match(sh.Name, Exceptions, 0)) Then
Select Case sh.Visible
Case xlSheetVisible
If Not VisibleFound Then VisibleFound = True
Case xlSheetHidden ' do nothing
Case xlSheetVeryHidden
If Not VeryHiddenFound Then
Set coll = New Collection
VeryHiddenFound = True
End If
coll.Add sh.Name
End Select
n = n + 1
SheetNames(n) = sh.Name
End If
Next sh
If n = 0 Then
MsgBox "No sheet found.", vbExclamation
Exit Sub
End If
If Not VisibleFound Then
MsgBox "No visible sheet found.", vbExclamation
Exit Sub
End If
If n < shCount Then ReDim Preserve SheetNames(1 To n) ' n - actual count
If VeryHiddenFound Then ' convert to hidden
For Each Item In coll
wb.Sheets(Item).Visible = xlSheetHidden
Next Item
End If
wb.Sheets(SheetNames).Copy ' copy to new workbook
If VeryHiddenFound Then ' revert to very hidden
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
For Each Item In coll
wb.Sheets(Item).Visible = xlSheetVeryHidden
dwb.Sheets(Item).Visible = xlSheetVeryHidden
Next Item
End If
MsgBox "Sheets exported: " & n, vbInformation
End Sub
Sub ExportSheetsTEST()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
ExportSheets wb, Array("DO NOT SAVE")
End Sub
Alternatively you could use the following snippet:
Sub CopyWorkbook()
Dim i As Integer
For i = 1 To ThisWorkbook.Sheets.Count
If ThisWorkbook.Sheets(i).Name <> "DO NOT SAVE" Then
Dim rng As Range
Windows("SOURCE WORKBOOK").Activate
rng = ThisWorkbook.Sheets(i).Cells
rng.Copy Before:=Workbooks("TARGET WORKBOOK").Sheets(i)
End If
Next i
End Sub
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
How can I populate a combobox from another workbook, assuming that my data are in a worksheet named "affectation" and the data are in the 1st column
My combobox is in a userform, to fill it from the activeworkbook I use this code :
Private Sub CommandButton1_Click()
Dim ws_Liste_affect As Worksheet
Set ws_Liste_affect = ActiveWorkbook.Worksheets("affectation")
Fin_Liste_affect = ws_Liste_affect.Range("A65530").End(xlUp).Row
For i = 2 To Fin_Liste_affect
UserForm1.ComboBox_affect.AddItem ws_Liste_affect.Range("A" & i)
Next
UserForm1.Show
End Sub
I wan to fill it from another workbook.
I (only) suppose that you need to populate a combo box using data from a sheet of another workbook. If my understanding is correct, please try the next code:
Private Sub CommandButton1_Click__()
Dim ws_Liste_affect As Worksheet, Fin_Liste_affect As Long, arr As Variant
Dim wbFullPath As String, wb As Workbook, boolFound As Boolean
wbFullPath = "C:\...\TheOtherWorkbook.xls"
For Each wb In Workbooks
If wb.FullName = wbfullname Then
Set ws_Liste_affect = wb.Worksheets("the other sheet")
boolFound = True: Exit For
End If
Next
If Not boolFound Then
Set wb = Workbooks.Open(vbfullpath)
Set ws_Liste_affect = wb.Worksheets("the other sheet")
End If
Fin_Liste_affect = ws_Liste_affect.Range("A" & Rows.count).End(xlUp).Row
arr = ws_liste.affect.Range("A2:A" & Fin_Liste_affect).Value
UserForm1.ComboBox_affect.List = arr
UserForm1.Show
End Sub
I asked a question earlier about a worksheet_change macro I was working on. It's almost complete, but now I'm stumped. I'm trying to loop through all the worksheets in the workbook, and if the worksheet's name is not found in any cell in range D6:D34, I want to delete the worksheet. How can I write this? I'm completely stumped. Current code:
Private Sub WorkSheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False 'Run faster
Application.DisplayAlerts = False 'Just in case
'To add worksheets automatically
Dim shtName As Variant
For Each shtName In Sheets(1).Range("D6:D34")
If shtName <> "" Then
If WorksheetExists((shtName)) Then 'do nothing
Else
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = shtName
Sheets("Admin").Select
End If
Else 'there's no sheet
End If
Next
'to delete sheets with no matching value
Dim ws_count As Integer
Dim i As Long
ws_count = ActiveWorkbook.Worksheets.Count
For i = 1 To ws_count
'what do I need here???
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Function WorksheetExists(sName As String) As Boolean
WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function
Dim ws As Worksheet
ws_count = ActiveWorkbook.Worksheets.Count
For i = ws_count To 2 Step -1
Set ws = ActiveWorkbook.Worksheets(i)
If IsError(Application.Match(ws.Name,Sheets(1).Range("D6:D34"),0)) then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next i
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