VBA - Excel Forces Restart - vba

I am having a major issue with my code that is supposed to reset the worksheets, not shut down the entire workbook and force a restart. This has not been an issue, and has only occured since I added the last bit of code starting at On Error Resume Next.
Sub Reset()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Set Up" Or ws.Name = "Report" Then
Else:
Application.DisplayAlerts = False
ws.Delete
End If
Next
Worksheets("Report").Cells.ClearContents
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Charts.Delete
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
Thanks in advance

If you have chart sheets, then you should use the following code:
Sub DeleteChartSheets()
Dim ch As Chart
For Each ch In ThisWorkbook.Charts
ch.Delete
Next
End Sub

this deletes the charts in a workhseet, say activesheet for example:
Sub DeleteallCharts()
Dim chtObj As ChartObject
For Each chtObj In ActiveSheet.ChartObjects
chtObj.Delete
Next
End Sub
if you want to delete all of the charts in the workbook, then you have to loop through the worksheet too like this:
Sub DeleteallChartsInWorkbook()
Dim chtObj As ChartObject
Dim WS As Worksheet
For Each WS in Thisworkbook.Worksheets
For Each chtObj In WS.ChartObjects
chtObj.Delete
Next chtObj
Next WS
End Sub

Related

VBA - error when deleting multiple worksheet

I wrote the VBA code to delete multiple sheets. It can delete as my purpose but i got the error below when it complete the deleting
Here is my code:
Option Explicit
Sub deletesheet()
Dim wb As Workbook
Dim sh1 As Worksheet
Dim i As Long
Dim ws As Worksheet
Set wb = ThisWorkbook
Application.DisplayAlerts = False
'On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
If ws.name <> "sheet1" Then
ws.Delete
End If
Next ws
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
If I put "On Error Resume Next" it can skip this issue, but i really want to know why it happen this and how to solve it ? Can you please help look ?

VBA Deleting blank worksheets where the worksheets have been renamed in Spanish?

I am working with a file where the worksheets have been renamed. Instead of Sheet1(generic name) it is Hoja1(generic name).
Wondering if this is stopping my code from working.
My code is very simple. I dont know what other error I could be having.
Sub Macro1()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Application.DisplaysAlerts = False
If LenB(ActiveSheet.Range("A5")) = "" Then ActiveSheet.Delete
Application.DisplayAlerts = True
Next ws
End Sub
Thank you.
If it's definitely going to have "Hoja" in the sheet name, this should work.
Sub Macro1()
Dim WS As Worksheet
Application.DisplayAlerts = False
For Each WS In ActiveWorkbook.Sheets
If InStr(WS.Name, "Hoja") <> 0 Then WS.Delete
Next
Application.DisplayAlerts = True
End Sub
Got some help from someone.
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Application.DisplayAlerts = False
If LenB(ws.Range"A5")) = 0 Then ws.Delete
Application.DisplayAlerts = True
Next ws
The spanish wasn't the issue.
To get the name Hoja1 if the sheet appears as Hoja1(1) in the VBA browser you can use the .CodeName property:
'code borrowed from Alex's answer
Sub Macro1()
Dim WS As Worksheet
Application.DisplayAlerts = False
For Each WS In ActiveWorkbook.Sheets
If InStr(WS.CodeName, "Hoja") <> 0 Then WS.Delete
Next
Application.DisplayAlerts = True
End Sub

Code to Unfilter data from all sheets present in the Workbook

I have a bunch of worksheets with only one table in each worksheet. I want to run a code that will unfilter/show all the data of all worksheet. so far i have written below code but it is not giving me the desire result.
dim ws1 as worksheet
On Error Resume Next
For Each ws1 In Worksheets
If ws1.FilterMode = True Then ws1.ShowAllData
Next ws1
On Error GoTo 0
Kindly review the above code and ammend.
Thanks
Salman
You may need to tackle this from the Range.Hidden Property point of view as well as the Worksheet.ShowAllData method. aspect. Data may have been hidden by other means than Range.AutoFilter Method.
Dim w As Long
For w = 1 To Worksheets.Count
With Worksheets(w)
.UsedRange.Cells.EntireRow.Hidden = False
If .AutoFilterMode Then .ShowAllData
End With
Next w
Use AutoFilterMode property..
Dim ws1 As Worksheet
On Error Resume Next
For Each ws1 In Worksheets
If ws1.AutoFilterMode = True Then ws1.AutoFilterMode = False
Next ws1
On Error GoTo 0
Try this code for your requirement.
Sub test1()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
For Each ws In wb.Worksheets
If Not ws.AutoFilterMode = False Then
ws.AutoFilterMode = False
End If
Next
End Sub

If statement to delete tab if there but move on if page is not there

I have a code that deletes a tab in the worksheet then runs another code. I am currently running into an issue that if the sheet is not there the code gives me an error... I'm wondering if I could make an if statement that looks if the tab is there and if not it moves on and if it is there it will delete it. I have the code that I have written already posted below but I have no idea how to do the if in the delete section.
Thanks!
Sub delete()
Dim ws As Worksheet
Set ws = Worksheets("Workbench Report")
Application.DisplayAlerts = False
ws.delete
Call Sorting
End Sub
Check if the sheet exists first:
Sub delete()
Dim ws As Worksheet
If WorksheetExists("Workbench Report") Then
Set ws = Worksheets("Workbench Report")
Application.DisplayAlerts = False
ws.delete
Call Sorting
End If
End Sub
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
Try this
Sub delete()
Dim i As Integer
i = 1
Application.DisplayAlerts = False
While i <= ActiveWorkbook.Worksheets.Count
Sheets(i).Select
If ActiveSheet.Name = "Workbench Report" Then
ActiveSheet.delete
End If
i = i + 1
Wend
Call Sorting
Application.DisplayAlerts = True
End Sub

On workbook open, Excel Macro to refresh all data connections sheets and pivot tables and then export the pivot to csv

I have an Excel File which has CSV Data sources and Pivot tables, I want to refresh all the data sources and pivot tables automatically and export one pivot table as CSV on opening the excel file.
I tried the below code, but this code export the CSV file before the data getting refreshed.
please help with a solution. Thanks in advance.
Private Sub Workbook_Open()
ThisWorkbook.RefreshAll
Run "Macro1"
End Sub
Sub Macro1()
Dim ws As Worksheet, newWb As Workbook
Dim SaveToDirectory As String
SaveToDirectory = "C:\Macro\"
Application.ScreenUpdating = False
For Each ws In Sheets(Array("locationwise"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs SaveToDirectory & ws.Name, xlCSV
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = False
End Sub
A simple DoEvents should do the trick! ;)
Try this :
Private Sub Workbook_Open()
ThisWorkbook.RefreshAll
DoEvents
Run "Macro1"
End Sub
And if it's not, just add this line after the DoEvents :
Application.Wait(Now + TimeValue("0:00:05"))
This will put on hold the execution of the code, here for 5 seconds!
If you want to launch the save parts once a specific range has been modified, place your that code into the sheet module :
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Me.Range(Rg_To_Check)) Is Nothing Then
'Not in range
Else
'In range to check
Run "Macro1"
End If
End Sub
And get rid of the Run "Macro1" in the Workbook_Open() event.
Also, be careful, because your last line is Application.DisplayAlerts = False you won't have alerts afterwards, you should use it like this instead :
Sub Macro1()
Dim ws As Worksheet, newWb As Workbook
Dim SaveToDirectory As String
SaveToDirectory = "C:\Macro\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws In Sheets(Array("locationwise"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs SaveToDirectory & ws.Name, xlCSV
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub