I have excel file with following codes to select the sheets.
Also there are few sheets with "xlSheetVeryHidden" to hide.
My issue is hidden sheets appears with these codes, I don't want to show hidden sheet. How to do it?
Private Sub CommandButton1_Click()
Dim myList As String
Dim mySht
For i = 1 To ActiveWorkbook.Sheets.Count
myList = myList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr
Next i
mySht = InputBox("Select Sheet to go to." & vbCr & myList)
ActiveWorkbook.Sheets(CInt(mySht)).Select
End Sub
Thanks,
Udara
Sheets can have three properties for .Visible i.e xlSheetHidden, xlSheetVeryHidden and xlSheetVisible
So you can either check for xlSheetHidden and xlSheetVeryHidden or directly check for xlSheetVisible
For example
For Each oSheet In ActiveWorkbook.Sheets
'~~> Loop through only visible sheets
If oSheet.Visible = xlSheetVisible Then
'
'~~> Rest of your code
'
End If
Next oSheet
You can determine a sheet is 'xlSheetVeryHidden' or not by checking Visible property.
Following code may show all sheets except sheets woth 'xlSheetVeryHidden' property.
Private Sub CommandButton1_Click()
Dim myList As String
Dim i as integer
Dim oSheet As Worksheet
Dim mySht As String
i = 1
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.Visible <> xlSheetVeryHidden Then 'Only this line is changed from "Parash J"'s code.
myList = myList & i & " - " & oSheet.Name & " " & vbCr
i = i + 1
End If
Next oSheet
mySht = InputBox("Select Sheet to go to." & vbCr & myList)
ActiveWorkbook.Sheets(mySht).Select
End Sub
Code has been fixed. Code works well at Excel 2013.
Even though you have hide the sheet with xlSheetVeryHidden option, it will be available in VBA code. You will need to bypass that sheet in the FOR LOOP. You just need to include If Statement to check if sheetname = "sheet1" then don't include that sheet in the list.
Check this code:
Private Sub CommandButton1_Click()
Dim myList As String
Dim i as integer
Dim mySht
i = 1
For Each oSheet In ActiveWorkbook.Sheets
''If oSheet.Name <> "Sheet1" Then '' to check for particular sheet.
If oSheet.Visible <> xlSheetVeryHidden Then '' For every sheet, set as xlsheetveryhidden
myList = myList & i & " - " & oSheet.Name & " " & vbCr
i = i + 1
End If
Next oSheet
mySht = InputBox("Select Sheet to go to." & vbCr & myList)
ActiveWorkbook.Sheets(CInt(mySht)).Select
End Sub
Note: Where Sheet1 is the very hidden sheet, you can name as you want.
Related
I have some Excel workbooks which contains more than 100 sheets. The sheet names like below;
TTBMA2453_Speclist, TTBMA2454_Speclist, TTBMA2455_Speclist and goes on..
WBXXTTBMA2453_Featurelist, WBXXTTBMA2454_Featurelist, WBXXTTBMA2455_Featurelist and goes on..
WBXXTTBMA2453_Corelist, WBXXTTBMA2454_Corelist, WBXXTTBMA2455_Corelist and goes on..
I want to split all spec, feature and corelist sheets which are starting with same speclist name in the same workbook and merge/save to another Excel workbook in a specific file using Excel VBA.
(e.g combining TTBMA2453_Speclist, WBXXTTBMA2453_Featurelist WBXXTTBMA2453_Corelist and copy them as new workbook with original sheets)
Please find the code sample I have. This code splits sheets of the same name (which I added manually) into workbooks. However, this code does not re-merge the sheets in a different workbook and sheet names are entered manually. So, that's not what I want.
Sub SplitEachWorksheet()
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ws As Worksheet
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
For Each ws In ThisWorkbook.Worksheets
If Left$(ws.Name, 9) = "TTBMA2453" Then ' <--- added an IF statement
ws.Copy
Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
Application.ActiveWorkbook.Close False
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub SplitEachWorksheet()
Dim wb As Workbook, wbNew As Workbook, ws As Worksheet
Dim num As Collection, n, dict As Object
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Set num = new Collection
Set dict = CreateObject("Scripting.Dictionary")
Set wb = ThisWorkbook
For Each ws In wb.Worksheets
If ws.Name Like "*_Speclist" Then
num.Add Left(ws.Name, Len(ws.Name) - 9)
End If
dict.Add ws.Name, ws.Index
Next
' check sheets
Dim msg As String, s As String
For Each n In num
s = "WBXX" & n & "_Corelist"
If Not dict.exists(s) Then
msg = msg & vbLf & s & " missing"
End If
s = "WBXX" & n & "_Featurelist"
If Not dict.exists(s) Then
msg = msg & vbLf & s & " missing"
End If
Next
If Len(msg) > 0 Then
MsgBox msg, vbCritical
Exit Sub
End If
' check workbooks
Application.ScreenUpdating = False
For Each n In num
wb.Sheets(n & "_Speclist").Copy
Set wbNew = ActiveWorkbook
wb.Sheets("WBXX" & n & "_Featurelist").Copy after:=wbNew.Sheets(1)
wb.Sheets("WBXX" & n & "_Corelist").Copy after:=wbNew.Sheets(2)
wbNew.SaveAs Filename:=FPath & "\" & n
wbNew.Close False
Next
Application.ScreenUpdating = True
' result
MsgBox num.Count & " worksbooks created in " & FPath, vbInformation
End Sub
The goal is to create a copied sheet that is renamed in the current month and year. The copied sheet is being created in the workbook, however a default name is given to the sheet. What am I missing?
Private Sub Button3_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim nowMonth As Integer, nowYear As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
nowMonth = Month(Now)
nowYear = Year(Now)
Set wb = ActiveWorkbook
On Error Resume Next
Set ws = wb.Sheet(nowMonth & ", " & nowYear)
On Error GoTo 0
If Not ws Is Nothing Then
MsgBox "The Sheet called " & nowMonth & ", " & nowYear & " already exists in the workbook.", vbExclamation, "Sheet Already Exists!"
Exit Sub
Else
Set ws = ActiveSheet.Copy(after:=wb.Sheets(wb.Sheets.Count))
ws.Name = nowMonth & ", " & nowYear
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
The problem is in Set ws = ActiveSheet.Copy(after:=wb.Sheets(wb.Sheets.Count)), because it is trying to Copy and Set in the same time and this is a bit too much.
Change the code in the condition to this:
If Not ws Is Nothing Then
MsgBox "something"
Exit Sub
Else:
Set ws = ActiveSheet
ws.Copy after:=wb.Sheets(wb.Sheets.Count)
wb.Worksheets(wb.Sheets.Count).Name = nowMonth & ", " & nowYear
End If
In general, avoid using Active and Select in VBA - How to avoid using Select in Excel VBA.
Worksheet.Copy disappointingly doesn't return a reference to the created sheet. Instead, it has the side-effect of adding a new sheet to the workbook, and activating it.
So after running Worksheet.Copy, the ActiveSheet is the newly created sheet.
ActiveSheet.Copy after:=wb.Sheets(wb.Sheets.Count)
ActiveSheet.Name = nowMonth & ", " & nowYear
Now, this code is confusing/misleading, because it looks like the two statements are qualified with the same object, but they aren't.
What's not clear, is why and how the ActiveSheet is guaranteed to be the correct sheet to copy; we're working off the ActiveWorkbook and we don't really care which sheet is active.
I'd suggest to make the copy work off an explicit sheet:
Dim sourceSheet As Worksheet
Set sourceSheet = wb.Sheets(wb.Sheets.Count)
sourceSheet.Copy after:=sourceSheet '<~ new sheet becomes ActiveSheet
ActiveSheet.Name = nowMonth & ", " & nowYear
And now everything is as clear as it gets.
I'm setting up a workbook that has two sheets. One sheet is for a data set and the second sheet is for analysis.
The data set sheet will be first (on the left/Sheet1) followed by the analysis sheet second (on the right/Sheet2).
Each sheet Name will have today's date and a title.
I would like to check if both sheets are present for today's date.
If Sheet1 is missing, add on the left.
If Sheet2 is missing, add on the right.
If both are missing, add both.
There should be no other sheets.
I have two modules. One checks for one sheet, and one checks for the other.
Option Explicit
Public szTodayRtsMU As String
Dim szTodayRawData As String
' Add and name a sheet with today's date.
Sub AddRtsMUsSheets_Today()
' Date and title.
szTodayRtsMU = Format(Date, "dd-mm-yyyy") & " " & "Rts & MUs"
On Error GoTo MakeSheet
' Check if sheet already exists, if it does, select activate it.
Sheets(szTodayRtsMU).Activate
' No errors, code is done.
Exit Sub
MakeSheet:
' If the sheet doesn't exist, add it.
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
' Name it
ActiveSheet.Name = szTodayRtsMU
End Sub
Sub AddRawDataSheets_Today()
' Date and title.
szTodayRawData = Format(Date, "dd-mm-yyyy") & " " & "Raw Data"
On Error GoTo MakeSheet
' Check if sheet already exists, if it does, select activate it.
Sheets(szTodayRawData).Activate
' No errors, code is done.
Exit Sub
MakeSheet:
' If the sheet doesn't exist, add it.
ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
' Name it
ActiveSheet.Name = szTodayRawData
End Sub
Tested, 100% working:
Option Explicit
Sub CheckForWorksheets()
Dim szTodayRawData As String
Dim szTodayRtsMU As String
Dim ws As Worksheet
Dim countRawData As Byte 'check if exists the RawData sheet
Dim countRTsMU As Byte 'check if exists the RtsMU sheet
'Date and titles
szTodayRawData = Format(Date, "dd-mm-yyyy") & " " & "Raw Data"
szTodayRtsMU = Format(Date, "dd-mm-yyyy") & " " & "Rts & MUs"
'Initialize the counters with 1
countRawData = 1
countRTsMU = 1
'This is a loop on all the worksheets on this workbook
For Each ws In ThisWorkbook.Worksheets
'If the sheets exists then the counter goes to 0
If ws.Name = szTodayRawData Then
countRawData = 0
ElseIf ws.Name = szTodayRtsMU Then
countRTsMU = 0
End If
Next ws
'Add the sheets if needed
With ThisWorkbook
If countRawData = 1 Then
Set ws = .Sheets.Add(before:=.Sheets(.Sheets.Count))
ws.Name = szTodayRawData
End If
If countRTsMU = 1 Then
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = szTodayRtsMU
End If
End With
'Delete any other sheet
For Each ws In ThisWorkbook.Sheets
If Not ws.Name = szTodayRawData And Not ws.Name = szTodayRtsMU Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
End Sub
If you need help understanding the code ask me anything.
I am trying to copy specific collections sheets within an excel workbook in separate workbooks. Not being a vba coder I have used and adapted code found here and other resource sites. I believe I am now very close having grasped the basic concepts but cannot figure out what i am doing wrong, triggering the below code causes the first new workbook to be created and the first sheet inserted but breaks at that point.
My code is below, additional relevant info - there is a sheet called 'List' which has a column of names. Each name on the list has 2 sheets which I am trying to copy 2 by 2 into new sheet of the same name. the sheets are labelled as the name and the name + H (e.g Bobdata & BobdataH)
Sub SheetCreate()
'
'Creates an individual workbook for each worksname in the list of names.
'
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String
Dim sname As String
Dim relativePath As String
Dim ListOfNames As Range, LRow As Long, Cell As Range
With ThisWorkbook
Set ListSh = .Sheets("List")
End With
LRow = ListSh.Cells(Rows.Count, "A").End(xlUp).Row '--Get last row of list.
Set ListOfNames = ListSh.Range("A1:A" & LRow) '--Qualify list.
With Application
.ScreenUpdating = False '--Turn off flicker.
.Calculation = xlCalculationManual '--Turn off calculations.
End With
Set wbSource = ActiveWorkbook
For Each Cell In ListOfNames
sname = Cell.Value & ".xls"
relativePath = wbSource.Path & "\" & sname
Sheets(Cell.Value).Copy
Set wbDest = ActiveWorkbook
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlExcel8
Application.DisplayAlerts = True
wbSource.Activate
Sheets(Cell.Value & "H").Copy after:=Workbooks(relativePath).Sheets(Cell.Value)
wbDest.Save
wbDest.Close False
Next Cell
MsgBox "Done!"
End Sub
You can try to change
Sheets(Cell.Value & "H").Copy after:=Workbooks(relativePath).Sheets(Cell.Value)
to
Sheets(Cell.Value & "H").Copy after:=wbDest.Sheets(Cell.Value)
Also it would be good idea to check if file already exists in selected location. For this you can use function:
Private Function findFile(ByVal sFindPath As String, Optional sFileType = ".xlsx") As Boolean
Dim obj_fso As Object: Set obj_fso = CreateObject("Scripting.FileSystemObject")
findFile = False
findFile = obj_fso.FileExists(sFindPath & "/" & sFileType)
Set obj_fso = Nothing
End Function
and change sFileType = ".xlsx" to "*" or other excet file type.
This was the code i created to create a new workbook and then copy sheet contents from existing one to the new one. Hope it helps.
Private Sub CommandButton3_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
TryAgain:
Flname = InputBox("Enter File Name :", "Creating New File...")
MsgBox Len(Flname)
If Flname <> "" Then
Set NewWkbk = Workbooks.Add
ThisWorkbook.Sheets(1).Range("A1:J100").Copy
NewWkbk.Sheets(1).Range("A1:J100").PasteSpecial
Range("A1:J100").Select
Selection.Columns.AutoFit
AddData
Dim FirstRow As Long
Sheets("Sheet1").Range("A1").Value = "Data Recorded At-" & Format(Now(), "dd-mmmm-yy-h:mm:ss")
NewWkbk.SaveAs ThisWorkbook.Path & "\" & Flname
If Err.Number = 1004 Then
NewWkbk.Close
MsgBox "File Name Not Valid" & vbCrLf & vbCrLf & "Try Again."
GoTo TryAgain
End If
MsgBox "Export Complete Close the Application."
NewWkbk.Close
End If
End Sub
I have an Excel VBA file with the following code. My issue is that the InputBox doesn't work correctly. There are 10 sheets. The first sheet is called "Menu". Other sheets as Sheet 2 - 10. Sheet 3,4 & 5 applied VeryHidden. Please help me to rectify it.
Private Sub CommandButton1_Click()
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> "Menu" Then
Sheet3.Visible = xlSheetVeryHidden
Sheet4.Visible = xlSheetVeryHidden
Sheet5.Visible = xlSheetVeryHidden
End If
Next Sh
Dim myList As String
Dim i As Integer
Dim mySht
i = 1
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.Visible <> xlSheetVeryHidden Then
myList = myList & i & " - " & oSheet.Name & " " & vbCr
i = i + 1
End If
Next oSheet
mySht = InputBox("Select Sheet to go to." & vbCr & myList)
ActiveWorkbook.Sheets(CInt(mySht)).Select
End Sub
Like I said in my comment above; The problem is Sheets(CInt(mySht)).
Problem
When you specify a number, say 3, then the code Sheets(CInt(mySht)) becomes Sheets(3). But this is not what you want. You want the name after that number as you are concatenating that number with " - " and then with the sheet name. Sheets(3) actually may be referring to the hidden sheet and not the 3rd Visible sheet and hence you are getting the error.
Option
Instead of using myList, use an array.
Split the array after the user makes a choice and then go to that sheet
Solution
Is this what you are trying?
Private Sub CommandButton1_Click()
Dim Sh As Worksheet
Dim ShName As String
Dim i As Integer
Dim mySht, MyAr
For Each Sh In ThisWorkbook.Worksheets
Sh.Visible = xlSheetVisible
Next Sh
Sheet3.Visible = xlSheetVeryHidden
Sheet4.Visible = xlSheetVeryHidden
Sheet5.Visible = xlSheetVeryHidden
For Each Sh In ThisWorkbook.Worksheets
If Sh.Visible = xlSheetVeryHidden Then i = i + 1
Next Sh
ReDim MyAr(1 To ThisWorkbook.Sheets.Count - i)
i = 1
'~~> Store the names of all visible sheets in the array
For Each Sh In ActiveWorkbook.Sheets
If Sh.Visible = xlSheetVisible Then
MyAr(i) = i & " - " & Sh.Name
i = i + 1
End If
Next Sh
'~~> Get user input
mySht = InputBox("Select Sheet to go to." & vbCr & Join(MyAr, vbNewLine))
If IsNumeric(mySht) Then
'~~> Get the actual sheet name using split as
'~~> we had actually appended " - " to it earlier
ShName = Trim(Split(MyAr(mySht), " - ")(1))
'~~> Activate the sheet
ThisWorkbook.Sheets(ShName).Activate
End If
End Sub