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
Related
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
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
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 creating a few macros to do the following in Excel 2010:
1. Upon creating a new worksheet ask for what the user wants to name his/her worksheet and sets the new worksheet to the name provided; calls Sort_Active_Book and Rebuild_TOC in order
2. Sort_Active_Book: Asks the user if he/she wants to sort the workbook's worksheets in ascending/descending order and proceeds to do so.
3. Rebuild_TOC: Deletes the Table of Contents page and rebuilds it based on all the worksheets in the workbook minus the TOC itself.
My problem is Excel keeps asking me to input the name of the new worksheet to be created and does not progress any further in the code. I notice it manages to create the named worksheet and asks me if I would like to sort ascending or descending but then proceeds to ask me again the name of the new worksheet. Could anyone please point out how to fix this and provide a code fix (if possible) please?
What I have already
This code portion is from ThisWorkbook, this is what prompts the user for the name of the worksheet upon creation.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim sName As String
Dim bValidName As Boolean
Dim i As Long
bValidName = False
Do While bValidName = False
sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
If Len(sName) > 0 Then
For i = 1 To 7
sName = Replace(sName, Mid(":\/?*[]", i, 1), " ")
Next i
sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
End If
Loop
Sh.Name = sName
Call Sort_Active_Book
Call Rebuild_TOC
End Sub
These two macros are in "Module 1":
Sub Sort_Active_Book()
Dim TotalSheets As Integer
Dim p As Integer
Dim iAnswer As VbMsgBoxResult
' Move the TOC to the begining of the document.
Sheets("TOC").Move Before:=Sheets(1)
' Prompt the user as to which direction they wish to
' sort the worksheets.
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) & "Clicking No will sort in Descending Order", vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For TotalSheets = 1 To Sheets.Count
For p = 2 To Sheets.Count - 1
' If the answer is Yes, then sort in ascending order.
If iAnswer = vbYes Then
If UCase$(Sheets(p).Name) = "TOC" Then
Sheets(p).Move Before:=Sheets(1)
ElseIf UCase$(Sheets(p).Name) > UCase$(Sheets(p + 1).Name) Then
Sheets(p).Move After:=Sheets(p + 1)
End If
' If the answer is No, then sort in descending order.
ElseIf iAnswer = vbNo Then
If UCase$(Sheets(p).Name) = "TOC" Then
Sheets(p).Move Before:=Sheets(1)
ElseIf UCase$(Sheets(p).Name) < UCase$(Sheets(p + 1).Name) Then
Sheets(p).Move After:=Sheets(p + 1)
End If
End If
Next p
Next TotalSheets
End Sub
and
Sub Rebuild_TOC()
Dim wbBook As Workbook
Dim wsActive As Worksheet
Dim wsSheet As Worksheet
Dim lnRow As Long
Dim lnPages As Long
Dim lnCount As Long
Set wbBook = ActiveWorkbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
' If the TOC sheet already exist delete it and add a new worksheet.
On Error Resume Next
With wbBook
.Worksheets(“TOC”).Delete
.Worksheets.Add Before:=.Worksheets(1)
End With
On Error GoTo 0
Set wsActive = wbBook.ActiveSheet
With wsActive
.Name = “TOC”
With .Range(“A1:B1”)
.Value = VBA.Array(“Table of Contents”, “Sheet # – # of Pages”)
.Font.Bold = True
End With
End With
lnRow = 2
lnCount = 1
' Iterate through the worksheets in the workbook and create sheetnames, add hyperlink
' and count & write the running number of pages to be printed for each sheet on the TOC.
For Each wsSheet In wbBook.Worksheets
If wsSheet.Name <> wsActive.Name Then
wsSheet.Activate
With wsActive
.Hyperlinks.Add .Cells(lnRow, 1), “”, _
SubAddress:=”‘” & wsSheet.Name & “‘!A1”, _
TextToDisplay:=wsSheet.Name
lnPages = wsSheet.PageSetup.Pages().Count
.Cells(lnRow, 2).Value = “‘” & lnCount & “-” & lnPages
End With
lnRow = lnRow + 1
lnCount = lnCount + 1
End If
Next wsSheet
wsActive.Activate
wsActive.Columns(“A:B”).EntireColumn.AutoFit
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
You are creating a new sheet with sub Rebuild_TOC. Causing the newsheet macro to run again.
You will need to avoid running the newsheet macro by adding a enableevents = false and true surrounding your code when creating a new sheet for your TOC. The rest of your code appears to be working as you want it to.
Application.EnableEvents = False
With wbBook
.Worksheets("TOC").Delete
.Worksheets.Add Before:=.Worksheets(1)
End With
Application.EnableEvents = True
Why would you want to delete the TOC worksheet, why not just update it?
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.