I am currently trying to build a a button click print macro to print all but two sheets (currently 5 total sheets). In addition I have a third sheet that I want the user to define how many pages of it to print. When I try to to have it be based off of a cell I get error 1004. To see if the rest of the code works and I make the module have a defined number excel crashes on me after it does the first sheet to print.
Sub Button1_Click()
Dim Wks As Worksheet, xcell As Integer
'The next line is where I get 1004 but when I change it to a fixed number it crashes excel'
xcell = Sheets("Print Page").Range("B12").Value
If xcell < 1 Then
MsgBox ("Please Enter the number of pages needed")
Exit Sub
Else
For Each Wks In ActiveWorkbook.Worksheets
If Wks.Visible = xlSheetVisible Then
If Wks.Name = "Print Page" Then
Else
If Wks.Name = "Specs" Then
Else
If Wks.Name = "Data" Then
Wks.PrintOut From:=1, To:=xcell
Else
Wks.PrintOut
End If
End If
End If
End If
Next Wks
End If
End Sub
There is probably a cleaner way to write this that I'm not aware of.
Not sure will these work on Mac. Below will keep prompting a value > 0 if that B12 is less than 1. Simplified your worksheet conditions and refers all objects within the workbook the macro is in.
Sub Button1_Click()
Dim Wks As Worksheet, xcell As Long, sInput As String
With ThisWorkbook
With .Worksheets("Print Page").Range("B12")
xcell = CLng(.Value)
If xcell < 1 Then
Do
sInput = InputBox("Please Enter the number of pages needed:", "Pages to print", 1)
If Len(sInput) = 0 Then Exit Sub ' Abort if clicked Cancel/left empty and clicked OK
If IsNumeric(sInput) Then xcell = CLng(sInput)
Loop Until xcell > 0
.Value = xcell
End If
End With
For Each Wks In .Worksheets
If Wks.Visible = xlSheetVisible Then
Select Case Wks.Name
Case "Print Page", "Specs" ' Skip!
Case "Data"
Wks.PrintOut From:=1, To:=xcell
Case Else
Wks.PrintOut
End Select
End If
Next Wks
End With
End Sub
Related
I need the VBA code to select ALL sheets (number and sheet names will vary from time to time) in a workbook except two specific sheets named "Overview" and "Index" (which also happens to be the left-most sheets on the tab list)
Is there "generic" code that can do this without naming each sheet (other than the two sheets that I do NOT want selected)
I tried the below code first to see if I could select all sheets except one:
Sub Macro1()
Dim i As Long
Sheet1.Select
For i = 2 To ThisWorkbook.Sheets.Count
If Sheets(i).Name <> "Overview" Then Sheets(i).Select Replace:=False
Next i
End Sub
but I kept getting a run-time error '1004; message and when I clicked debug it would highlight the "sheet1.slecet" line of code.
Here's an option.
Sub SelectWS()
Dim WS As Worksheet
Dim I As Long
Dim N As Long
Dim Fnd As Boolean
Dim Vis As Boolean
N = 0
For Each WS In ThisWorkbook.Worksheets
Vis = (WS.Visible = xlSheetVisible)
If Vis = False Then N = N + 1
If WS.Name <> "Overview" And WS.Name <> "Index" And Vis Then
Fnd = True
If ActiveSheet.Name = "Overview" Or ActiveSheet.Name = "Index" Then
WS.Activate
WS.Select
Else
WS.Select (False)
End If
End If
Next WS
If Not Fnd Then
MsgBox "No suitable WS found.", vbInformation + vbOKOnly, "Error:"
ElseIf N > 0 Then
MsgBox "Found " & N & " hidden Worksheet(s) - not selectable.", vbInformation + vbOKOnly, "Notice:"
End If
End Sub
Try this:
Sub Macro1()
Dim iSel As Long, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, _
Array("Overview", "Index"), 0)) Then
ws.Select Replace:=(iSel = 0) 'only Replace for first-selected sheet
iSel = iSel + 1 'increment selected sheet count
End If
Next ws
End Sub
(assumes no hidden sheets)
I want to check if specific range (L32,M32;N32;O32;P32;Q32,R32;S32;T32).
If one of the cells is not empty a message should be displayed "FSFV check".
For Each cell In Range("L32:T32")
If cell.Value <> "" Then
MsgBox "Check with CRA if FSFV was performed and notify RA"
Else
End If
Next
End Sub
It displays the message eight times but I only want it once.
How about :
Sub Test()
Dim AnyData As Integer
AnyData = WorksheetFunction.CountA(Range("L32:T32"))
If AnyData = 0 Then
Exit Sub
Else
MsgBox "Check with CRA if FSFV was performed and notify RA"
End If
End Sub
If a Cell in a Range Is Blank...
If you're practicing loops, you could do the following.
Sub Test1()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim cell As Range
For Each cell In ws.Range("L32:T32").Cells
If Len(CStr(cell.Value)) = 0 Then ' cell is blank
MsgBox "Check with CRA if FSFV was performed and notify RA", _
vbExclamation
Exit For ' blank cell found, stop looping
' Or:
'Exit Sub ' blank cell found, stop looping
End If
Next cell
' With 'Exit For' you'll end up here
' and you could continue with the sub.
End Sub
If not, rather use the following.
Sub Test2()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
If Application.CountBlank(ws.Range("L32:T32")) > 0 Then
MsgBox "Check with CRA if FSFV was performed and notify RA", _
vbExclamation
End If
End Sub
Hardly Related But Interesting
If you were wondering what happens to an object-type Control variable (in this case cell) in a For Each...Next loop when the loop has finished uninterrupted, the following example proves that it is set to Nothing.
Sub Test3()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim cell As Range
For Each cell In ws.Range("L32:T32").Cells
If Len(CStr(cell.Value)) = 0 Then Exit For
Next cell
If Not cell Is Nothing Then
MsgBox "Check with CRA if FSFV was performed and notify RA", _
vbExclamation
Exit Sub
End If
MsgBox "Continuing...", vbInformation
End Sub
Let me give you the simplest approach:
Dim Found As Boolean
Found = False
For Each cell In Range("L32:T32")
If cell.Value <> "" Then
Found = True
End If
Next
If Found Then
MsgBox "Check with CRA if FSFV was performed and notify RA"
End If
As you see, the fact that you have found an empty cell is kept in a Boolean variable, and afterwards you just use that information for showing your messagebox.
I'm adding a new worksheet to my workbook with
Application.ScreenUpdating = False
SheetExists = False
For Each WS In Worksheets
If WS.Name = "BLANK" Then
SheetExists = True
End If
Next WS
If Not SheetExists Then
Sheets.Add
ActiveSheet.Name = "BLANK"
End If
Is there any way to sheets.add silently without bringing focus to or activating the new added sheet? I just want to stay on the sheet (ie. Sheet1) that is currently active and add the new sheet in the background.
Thanks
At first, things look simple but there are a few things to consider:
There could be more sheets selected before running the code
The selected sheet(s) could be Chart sheet(s)
The Workbook can be protected
You might not want to set Application.ScreenUpdating = True at the end of the method because you might be running this from within another method that still needs it off
Restoring selection can only happen if the proper window is activated
You could use this method:
Sub AddWorksheet(ByVal targetBook As Workbook, ByVal sheetname As String)
Const methodName As String = "AddWorksheet"
'Do input checks
If targetBook Is Nothing Then
Err.Raise 91, methodName, "Target Book not set"
ElseIf sheetname = vbNullString Then
Err.Raise 5, methodName, "Sheet name cannot be blank"
ElseIf Len(sheetname) > 31 Then
Err.Raise 5, methodName, "Sheet name cannot exceed 31 characters"
Else
Dim arrForbiddenChars() As Variant
Dim forbiddenChar As Variant
arrForbiddenChars = Array(":", "\", "/", "?", "*", "[", "]")
For Each forbiddenChar In arrForbiddenChars
If InStr(1, sheetname, forbiddenChar) > 0 Then
Err.Raise 5, methodName, "Sheet name cannot contain characters: : \ / ? * [ or ]"
End If
Next forbiddenChar
End If
Dim alreadyExists As Boolean
'Check if a sheet already exists with the desired name
On Error Resume Next
alreadyExists = Not (targetBook.Sheets(sheetname) Is Nothing)
On Error GoTo 0
If alreadyExists Then
MsgBox "A sheet named <" & sheetname & "> already exists!", vbInformation, "Cancelled" 'Can remove
Exit Sub
End If
'Check if Workbook is protected
If targetBook.ProtectStructure Then
'Maybe write code to ask for password and then unprotect
'
'
'Or simply exit
MsgBox "Workbook is protected. Cannot add sheet", vbInformation, "Cancelled"
Exit Sub
End If
Dim bookActiveWindow As Window
Dim appActiveWindow As Window
Dim selectedSheets As Sheets
Dim screenUpdate As Boolean
Dim newWSheet As Worksheet
'Store state
Set bookActiveWindow = targetBook.Windows(1)
Set appActiveWindow = Application.ActiveWindow 'Can be different from the target book window
Set selectedSheets = bookActiveWindow.selectedSheets
screenUpdate = Application.ScreenUpdating
'Do main logic
screenUpdate = False
If bookActiveWindow.Hwnd <> Application.ActiveWindow.Hwnd Then
bookActiveWindow.Activate
End If
If selectedSheets.Count > 1 Then selectedSheets(1).Select Replace:=True
Set newWSheet = targetBook.Worksheets.Add
newWSheet.Name = sheetname
'Restore state
selectedSheets.Select Replace:=True
If appActiveWindow.Hwnd <> Application.ActiveWindow.Hwnd Then
appActiveWindow.Activate
End If
Application.ScreenUpdating = screenUpdate
End Sub
If you want the book containing the code then you can call with:
Sub Test()
AddWorksheet ThisWorkbook, "BLANK"
End Sub
or, if you want the currently active book (assuming you are running this from an add-in) then you can call with:
Sub Test()
AddWorksheet ActiveWorkbook, "BLANK"
End Sub
or any other book depending on your needs.
Just remember who was active:
Sub ytrewq()
Dim wsh As Worksheet, SheetsExist As Boolean
Set wsh = ActiveSheet
Application.ScreenUpdating = False
SheetExists = False
For Each ws In Worksheets
If ws.Name = "BLANK" Then
SheetExists = True
End If
Next ws
If Not SheetExists Then
Sheets.Add
ActiveSheet.Name = "BLANK"
End If
wsh.Activate
Application.ScreenUpdating = False
End Sub
I would like to iterate through a list of sheets where the list is determined by a Range.
If I hard-code the list everything is fine.
what I'd like is to refer to a range that contains the sheet names (as it's variable).
Set mySheets = Sheets(Array("sheetOne", "sheetTwo", "sheetThree"))
With ActiveWorkbook
For Each ws In mySheets
'do the stuff here
Next ws
End With
so something like this:
Set mySheets = Sheets(Range("A1:E1"))
Any ideas?
This will work:
Sub MySub()
On Error Resume Next
Set mySheets = Sheets(removeEmpty(rangeToArray(Range("A1:E1"))))
If Err.Number = 9 Then
MsgBox "An error has occurred. Check if all sheet names are correct and retry.", vbCritical
Exit Sub
End If
On Error GoTo 0
With ActiveWorkbook
For Each ws In mySheets
'do the stuff here
Next ws
End With
End Sub
'This will transpose a Range into an Array()
Function rangeToArray(rng As Range) As Variant
rangeToArray = Application.Transpose(Application.Transpose(rng))
End Function
'This will remove empty values and duplicates
Function removeEmpty(arr As Variant) As Variant
Dim result As New Scripting.Dictionary
Dim element As Variant
For Each element In arr
If element <> "" And Not result.Exists(element) Then
result.Add element, Nothing
End If
Next
removeEmpty = result.Keys
End Function
This will load dynamically Sheets contained in your Range.
Edit
Added Function removeEmpty(...) to remove empty values and duplicates.
Note: the Function rangeToArray() is needed to return data in Array() format.
I hope this helps.
I would provide this solution, which does load the sheetnames into an array:
Notice that you have to transpose the Data if the values are ordered horizontal.
Public Sub test()
Dim mySheet As Variant
Dim sheet As Variant
mySheet = Application.Transpose(Tabelle1.Range("A1:E1").Value) 'load your Values into an Array, of course the range can also be dynamic
For Each sheet In mySheet
Debug.Print sheet 'print the sheet names, just for explaining purposes
'it may be necessary to use CStr(sheet) if you want to refer to a sheet like Thisworkbook.Worksheets(CStr(sheet))
'Do something
Next sheet
Erase mySheet 'delete the Array out of memory
End Sub
I demonstrate the code below which does what you want using an animated gif (click for better detail)
Option Explicit
Sub iterateSheets()
Dim sh As Worksheet, shName As String, i As Integer
i = 0
For Each sh In ThisWorkbook.Worksheets
shName = sh.Range("A1").Offset(i, 0)
Worksheets(shName).Range("A1").Offset(i, 0).Font.Color = vbRed
i = i + 1
Next
End Sub
you could do like this:
Sub DoThat()
Dim cell As Range
For Each cell In Range("A1:E1").SpecialCells(xlCellTypeConstants)
If Worksheets(cell.Value2) Is Nothing Then
MsgBox cell.Value2 & " is not a sheet name in " & ActiveWorkbook.Name & " workbook"
Else
With Worksheets(cell.Value2)
'do the stuff here
Debug.Print .Name
End With
End If
Next
End Sub
or the other way around:
Sub DoThatTheOtherWayAround()
Dim sht As Worksheet
For Each sht In Worksheets
If Not IsError(Application.Match(sht.Name, Range("A1:E1"), 0)) Then
'do the stuff here
Debug.Print sht.Name
End If
Next
End Sub
but in this latter case, you wouldn't be advised in case of any A1:E1 value not corresponding to actual sheet 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