I would like to know why VBA is telling me that the SUB function is missing while trying to write this code. The purpose should be that when the sheet is called NVT the code should skip any operation and go to the next sheet that will be activated (in the next command). In the end of this operation I should delete every blanc sheet(s) where there is no "specific name" or "NVT" filled in.
The formula is working good without this option. I have no problem saving this code and no problem with the formula itselve. Any suggestion is welcom.. I don't believe this threat has been posted yet.
Please let me know if you need additional information. The original code is verry long and would like just a indication how to sove this issue.Thanx in advace for who will answer tis threat.
Sub Printtabs()
' Print
ThisWorkbook.Activate
If ThisWorkbook.Sheets(7) = ("NVT") Then Skip
If ThisWorkbook.Sheets(7) = ("NAME SPECIFIC 1") Then
'process formula
End If
If Thisworkbook.Sheets (8) = ("NVT) Then Skip
If Thisworkbook.Sheets (8) = ("NAME SPECIFIC 2") Then
'process formula
End If
'then I should find the way to delete every "blanc" sheets in this workbook (becouse I skipped before and there will be blanc sheets) and save
End Sub
You don't need to use .Activate. You can directly work with the sheets. Also when deleting sheets and switching off events, always use proper error handling.
Is this what you are trying?
Dim ws As Worksheet
Sub Printtabs()
On Error GoTo Whoa
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "NAME SPECIFIC 1" Then
'~~> Process Formula
ElseIf ws.Name = "NAME SPECIFIC 2" Then
'~~> Process Formula
Else
If ws.Name <> "NTV" And WorksheetFunction.CountA(ws.Cells) = 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
Next ws
LetsContinue:
Application.DisplayAlerts = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
So, I figured out how to delete the blanc sheets I believe.
Only the issue with sheetsnames is remaining.
This part of code I will run at the end of all processed formulas.
Hopely somebody could help me out....
Dim ws As Worksheet
For Each ws In Worksheets
If WorksheetFunction.CountA(ws.Cells) = 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
Related
I have a macro that generates a lot of worksheets and charts. There's also various subroutines that run so the names and quantity of each worksheet/chart generated is never the same. What is constant is my HOME worksheet which is the UI for the user and I want it to be unaffected.
I found a similar question here about deleting all worksheets except the one you are working with (i.e. HOME). Here's what I have so far.
Sub ZRESET()
Dim ws As Worksheet, wb As Workbook
Set wb = ActiveWorkbook
Sheets("HOME").Select
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
If ws.Name <> "HOME" Then
ws.Delete
End If
If Chart.Name = "" Then
Charts.Delete
End If
Next
Application.DisplayAlerts = True
Range("B5:E5,B9:E9,B13:E13,B14:E14").ClearContents
Range("A1").Select
End Sub
The worksheets delete fine, the hang up I have is the charts. I tried various attempts to remove charts and sometimes they work (i.e placing Charts.Delete outside of a FOR loop and IF statement). But this requires me to actually have a chart in the workbook. Sometime the user can just develop worksheets but no charts.
Any advice to continue my goal of deleting SHEETS and/or CHARTS, while keeping my HOME sheet intact?
Option Explicit
Sub GetRid()
Dim ASheet As Worksheet
Dim AChart As Chart
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'** first scan for and delete all non HOME worksheets ***
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
ASheet.Delete
End If
Next
'** Now scan and delete any ChartSheets ****
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub AllSheetsAndcharts()
Dim AChart As ChartObject
Dim ASheet As Worksheet
Application.DisplayAlerts = False
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
For Each AChart In ASheet.ChartObjects
AChart.Delete
Next
ASheet.Delete
End If
Next
Application.DisplayAlerts = False
End Sub
I wrote a simple macro to loop through all the sheets. However, it only applies to the first sheet. I've already read the other posts which have success so I'm not sure why my code won't work.
Sub Archive_Sheets()
For Each ws In ActiveWorkbook.Worksheets
Range("B2").Value = "DONE"
Next ws
End Sub
Any ideas what might be causing this?
You must write you code like-
ws.Range("B2").Value = "DONE"
You forgot to use ws. at the beginning of said range. Otherwise, VBA will auto-complete Range("B2").Value = "DONE" to ActiveSheet.Range("B2").Value = "DONE". But that's not what you want (I assume). So, this is what you should try instead:
Sub Archive_Sheets()
For Each ws In ActiveWorkbook.Worksheets
ws.Range("B2").Value = "DONE"
Next ws
End Sub
I know it is because of the "Or" but I was hoping someone could explain why it does not work.
If (Sheet.Name <> "Dep 1" Or "Test") Then
^
Sub DeleteSheet()
Dim Sheet As Worksheet
Application.DisplayAlerts = False
For Each Sheet In ActiveWorkbook.Sheets
If (Sheet.Name <> "Dep 1" Or "Test") Then
Sheet.Delete
End If
Next Sheet
Application.DisplayAlerts = False
End Sub
My "Two-cents" to this post:
Try to use meaningful variable names, but NOT ones that are too close to Excel's saves words. Dim Sheet is ~ 85% similar to Sheets, which is a type of Object, I've seen so many posts here that people get cell with Cells mixed-up and get a run-time error.
I've switched your If with Select Case .Name, this way, if in the future you have add more Worksheets or want to perform other actions on other Worksheets, it will be easier to modify the code.
Code
Option Explicit
Sub DeleteSheet()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Sheets
With ws
Select Case .Name
Case "Dep 1", "Test"
' do nothing for now
Case Else
.Delete
End Select
End With
Next ws
Application.DisplayAlerts = True ' <-- restore setting
End Sub
I am a new user of vba.
There is recently a vba problem that has left me rather clueless and helpless - subscript out of range - on a particular user's computer when every other user seems to have no issue with using the macro (myself included) hence I can't simply trial and error to troubleshoot.
Hence really need expert help from all of you! Really really appreciated!!
I have used a series of vba, which will run one after another and have pasted them in chronological order as follows.
VBA 1
Sub VBA_1()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Outline.ShowLevels 1, 1
Next ws
End Sub
VBA 2
Sub VBA_2()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect ("Password")
Next ws
End Sub
VBA 3
Sub VBA_3()
Dim iRet As Integer
Dim strPrompt As String
'Prompt
strPrompt = "This will take about 2 minutes. Click 'OK' to proceed."
'Show msgbox
iRet = MsgBox(strPrompt, vbOKCancel)
'When user clicked 'OK'..
If iRet = vbOK Then
'SaveAs Function
Dim fName As String
fName = Application.GetSaveAsFilename(, "Excel Binary Workbook (*.xlsb), *.xlsb")
If fName = "False" Then
MsgBox "File not saved.", vbOKOnly
Cancel = True
End If
Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlExcel12
Application.EnableEvents = True
' Calculate
Application.Calculate
Application.ScreenUpdating = True
' Outlet
Worksheets("Total Outlets").Activate
'Copy and Paste this portion to each worksheet
For Each cell In Range("A1")
If cell.Value = "Not Applicable" Then
ActiveSheet.Visible = xlSheetHidden
Else
Call HypMenuVRefresh
End If
Next
'End Outlet & Copy and Paste
Worksheets("D11101").Activate
For Each cell In Range("A1")
If cell.Value = "Not Applicable" Then
ActiveSheet.Visible = xlSheetHidden
Else
Call HypMenuVRefresh
End If
Next
Worksheets("D11102").Activate
For Each cell In Range("A1")
If cell.Value = "Not Applicable" Then
ActiveSheet.Visible = xlSheetHidden
Else
Call HypMenuVRefresh
End If
Next
'Hide sheets accordingly
Worksheets("Restaurant List").Visible = xlSheetVeryHidden
Worksheets("Hotel List").Visible = xlSheetVeryHidden
'Recalculate
Application.Calculate
Application.ScreenUpdating = True
'Renaming of tabs
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Range("A2").Value = 1 Then
If ws.Visible = xlSheetVisible Then
On Error Resume Next
ws.Name = ws.Range("A10").Value
End If
End If
Next ws
'Save Workbook
ActiveWorkbook.Save
'Enable finishing screen to be 'Input'
Sheets("Input").Select
'Show msgbox
MsgBox ("Retrieval Completed!")
Else
MsgBox ("Retrieval of Data Cancelled")
End If
End Sub
I can think of the following possible causes but do not say any of them is the actual cause:
"...on a particular user's computer..."
Then:
the version of Excel/VBA is different;
somehwere a global Option Base is set (but I believe this cannot be set global, i.e. applicable to all workbooks loaded);
somewhere a separator is "hard coded" that does not conform to the Windows global setings (Control Panel --> Region and Language --> Formats --> Additional Settings);
the language differs with a reflection in VBA (e.g. a keyword/function name in the native language or identifier names with non-US ASCII 7 bit characters).
To find in where the program encounters the error (and stops), make a function that writes a status message to a file after every major step. Make sure to close the file after every message so the message is actually written.
In Excel, I need to delete all sheets which don't end in (2)
The following code corrently deletes those which DO end in (2), I'm just not sure how to reverse this, 'Not Like' doesn't seem to work
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name Like "*" & "(2)" Then
'~~> This check is required to ensure that you don't get an error
'~~> if there is only one sheet left and it matches the delete criteria
If ThisWorkbook.Sheets.Count = 1 Then
MsgBox "There is only one sheet left and you cannot delete it"
Else
'~~> This is required to supress the dialog box which excel shows
Application.DisplayAlerts = False
ws.delete
Application.DisplayAlerts = True
End If
End If
Next
Not works fine here, you just have to negate the full expression
If Not ws.Name Like "*" & "(2)" Then
Just a slight tip over your current code. Move the Application.DisplayAlerts outside of your loop. These only need to be turned off and on once in the entire macro, where as you're turning it off an on for each sheet. This increases the number of iterations in your code and bloats your macro.
Also for your original question your if statement runs if the (2) is present in the sheet name. To change this simply put Not after the if.
You can also do this using just one If statement slimming down your code once again.
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
If Not ws.Name Like "*" & "(2)" and ThisWorkbook.Sheets.Count > 1 Then
ws.delete
ElseIf ThisWorkbook.sheets.count = 1 then
MsgBox "There is only one sheet left and you cannot delete it"
Exit Sub
End If
Next ws
Application.DisplayAlerts = True