I am trying to run a macro that will remove any rows that have a #REF! as well as remove the header. On top of all of that, I would also like for the macro to go through and apply this option for all worksheets except the first one.
When I try to run it acts as if it worked, but when I checked the specific worksheets where this applies nothing has happened.
Sub RemoveGamesOut()
Dim i As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "1962-63 Stats" Then ws.Range ("C6:C5000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For i = Range("C" & Rows.Count).End(3).Row To 5 Step -1
If IsError(Cells(i + 1, "C")) = True Then Rows(i).Resize(2).Delete
Next i
Next ws
End Sub
Related
I have over 20 sheets with VBA codes that performs calculations realtime and simultaneously. All the calculations on each sheet are working fine except some COUNTIF and FIND ADDRESS function whereby VBA ignores running them on every other sheet unless I'm active on that sheet, then it works.
I have tried several methods and this one works by activating all the sheets from another sub
Worksheets("Sheet2").activate
Worksheets("Sheet3").activate
Worksheets("Sheet4").activate
By doing this, the COUNTIF and FIND ADDRESS functions works on all sheets however, it's flickering through all of the sheets. I was also able to get it to stop on one sheet by adding (Worksheets("Sheet1").activate) at the end of the last sub. This doesn't fix the issue as I am unable to check any other sheet. I also tried
Application.ScreenUpdating = False 'At the beginning of the sub
Application.ScreenUpdating = True 'At the end of the sub
No luck. Tried wrapping each code in the vba around
Dim ws As Worksheets
ws.activate
Doesn't fix the issue. How can I activate all sheets without flickering through them? If activating them all at once can't fix the issue, is there another way? Thank you
Here is the sample of the code -
psup = "Generated" & " " & lBar
If Abs(sp2) = 0 Then
If Cells.Find(psup).Offset(-8, 0).Value > 3 Or Cells(b + 1, h).Offset(-8, 0).Value > 3 Then
Call allNewYes
'Cells(b - 7, h).Value = Cells(b - 7, h).Value + 4
sp2 = 1
End If
End If
'1.Get Position - Generated
If Application.WorksheetFunction.CountIf(ActiveSheet.Cells, psup) > 2 Then
sp6 = Application.WorksheetFunction.CountIf(ActiveSheet.Cells, psup) - 1
Call spLocation
Else
If Application.WorksheetFunction.CountIf(ActiveSheet.Cells, psup) > 0 Then
sp5 = Cells.Find(psup).Address
End If
End If
Sub allNewYes()
Dim locazion As String
Dim FindValue As String
FindValue = psup
Dim FindRng As Range
Set FindRng = Cells.Find(What:=FindValue)
Dim FirstCell As String
FirstCell = FindRng.Address
Do
locazion = FindRng.Address
Range(locazion).Offset(-8, 0).Value = Abs(Range(locazion).Offset(-8, 0).Value) + 4
Set FindRng = Cells.FindNext(FindRng)
Loop While FirstCell <> FindRng.Address
End Sub
Here is a mock-up of how you perform actions on multiple worksheets, without selecting or activating them - using part of your code as an example. I wasn't sure how you create FindValue - so you'd have to do that part yourself.
Sub perform_actions_on_all_sheets()
Dim wb As Workbook, ws As Worksheet, FindRng As Range, FirstCell As String
FindValue = 5 'change this to something appropriate
Set wb = ThisWorkbook
For Each ws In wb.Sheets
If ws.Name <> "ExcludeThisWorksheetName" Then
'do stuff to ws, e.g.
Set FindRng = ws.Cells.Find(What:=FindValue)
If Not (FindRng Is Nothing) Then
FirstCell = FindRng.Address
Do
FindRng.Offset(-8, 0).Value = Abs(FindRng.Offset(-8, 0).Value) + 4
Set FindRng = ws.Cells.Find(FindValue, LookIn:=xlValues, LookAt:=xlWhole)
Loop While FirstCell <> FindRng.Address
End If
End If
Next
End Sub
The If ws.Name <> "ExcludeThisWorksheetName" Then ... End If is optional - this is usually required if you want to run the script on every tab except one.
For anyone experiencing similar issues, by removing (ActiveSheet.Cells) in my code fixed the issue
I'm trying to write code to have several Sheets in a file printed in one print job.
The Sheets to be printed are created dynamically; their names and the number of sheets differ each time, but I know that I want to print all sheets in the workbook apart from Keep1 and Keep2 (In real 7 different sheet names).
The reason I want to print all sheets in one job is that it could be many sheets, and this would mean a long wait and lots of print job pop-ups.
To realize the above, I thought of creating a selection of the sheets I want to print and then order to print.
I wrote the following:
Sub printtest()
Dim arr As Variant, sht As Worksheet
arr = Array("Keep1", "Keep2")
Application.DisplayAlerts = False
For Each sht In ThisWorkbook.Worksheets
If Not UBound(Filter(arr, sht.Name, True, vbtruecompare)) >= 0 Then
With sht.PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
sht.Select False
End If
Next sht
SelectedSheets.PrintOut
Application.DisplayAlerts = True
End Sub
After running the code, I run into the following:
sht.Select False adds up each Sheet meeting the conditions to the current selection, but since the button is on active sheet Keep1 this sheet is part of the selection (and should not be):
The .FitToPagesWide = 1 is performed for each Sheet in the selection, but .FitToPagesTall is also set to 1 (I want to keep this as Automatic, but don't know how to.
I don't know how to reference the selection in my print job properly.
I tried:
sht.PrintOut which results in Run-time error 91 (Object variable or With block variable not set).
SelectedSheets.PrintOut which results ion Run-time error 424 (Object required).
My vba knowledge is limited and I can't find a way to reference the selected pages for the printout.
Thanks for looking into this and explaining what is wrong in this approach.
Print Multiple Worksheets
You rarely need to select anything which is shown in the following code.
It writes the worksheet names to the keys of a dictionary, which are actually an array, and uses this array (the keys) to reference the worksheets to be printed.
Sub PrintTest()
Dim Exceptions() As Variant: Exceptions = Array("Keep1", "Keep2")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, Exceptions, 0)) Then
With ws.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
End With
dict.Add ws.Name, Empty
End If
Next ws
ThisWorkbook.Worksheets(dict.Keys).PrintOut
Application.DisplayAlerts = True
End Sub
You could try to make a string with only the worksheet names you want, excluding Keep1 and Keep2. Then take that string into an unidimensional array and use that array as your selection of worksheets:
Dim wk As Worksheet
Dim StringWk As String
Dim ArrayWk As Variant
'string of wk names
For Each wk In ThisWorkbook.Worksheets
If wk.Name <> "Keep1" And wk.Name <> "Keep2" Then StringWk = StringWk & wk.Name & "|"
Next wk
StringWk = Left(StringWk, Len(StringWk) - 1) 'clean last | delimiter in string
ArrayWk = Split(StringWk, "|")
Sheets(ArrayWk).Select
'code to print to pdf or whatever
'
'
'
'
'
Sheets("Keep1").Select 'deactivate selection
Erase ArrayWk
To create the array we use SPLIT:
Split
function
After a few iterations of the following code I always get the error that the index was out of bounds.
For i = myworksheet.index To Worksheets.count
Sheets(i).delete
Next i
You shouldn't delete sheets this way.
Consider what you're asking it to do. Let's say you have 5 worksheets- Sheet1, Sheet2.. Sheet 5.
Let's say myworksheet is Sheet3 (i=3).
When the loop starts, i is 3.
Sheet3 is deleted.
The loop restarts and i is now 4.
However, there are now only 4 worksheets. So Sheet5 (i=4) is deleted.
The loop restarts and i is now 5.
However, there are now only 3 worksheets. There is no worksheet with index of 5 to delete.
One (of many) ways to achieve your goal is to do the following:
i = myworksheet.Index
Do Until Worksheets.Count = i - 1
Worksheets(Worksheets.Count).Delete
Loop
One thing to point out with this.. in your code, you appear to be deleting your start sheet myworksheet. Because of this, the Do Until... loop I've created finishes at i-1 to stop after myworksheet is deleted. If you didn't want this to happen, remove the - 1. If you did want this to happen, you need to be aware that it will error if the index of myworksheet is 1 - as all workbooks must contain at least 1 worksheet.
Try the next way, please. In your code, after sheets deleting, the reference not make sense for i bigger then existing maximum (remained) one:
Sub deleteSheets()
Dim sh As Worksheet, ws As Worksheet
Set sh = ActiveSheet
For Each ws In ActiveWorkbook.Sheets
If ws.Index > sh.Index Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next
End Sub
Or looping backwards, as #SJR suggested:
Sub deleteSheetsBis()
Dim myworksheet As Worksheet, i As Long
Set myworksheet = ActiveSheet
For i = ActiveWorkbook.Worksheets.count To myworksheet.Index Step -1
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
Next i
End Sub
I have a workbook that uses a macro and makes many sheets. After one sheet, called Paste, I want to be able to delete the sheets that follow once I am done using them.
I found the following code from https://stackoverflow.com/a/53544169/11615632 and slightly modified it to use in my workbook.
Sub Deleting()
Dim Indx As Long
Dim x As Long
With ThisWorkbook
On Error Resume Next
Indx = .Sheets("Paste").Index
On Error GoTo 0
If Indx <> 1 Then
If .Sheets.Count > 2 And Indx < .Sheets.Count Then
Application.DisplayAlerts = False
For x = .Sheets.Count To Indx + 1 Step -1
.Sheets(x).Delete
On Error GoTo 0
Next x
Application.DisplayAlerts = False
End If
Elseif Indx = 1 Then
Exit Sub
End If
End With
End Sub
However, when I do this it actually works, but I get an error message saying
"Run-time error '-2147319765':
Automation Error
Element not found.
The error is found on the line .Sheets(x).Delete
Since you know that you want to keep two specific sheets ("Value" and "Paste"), instead of using the indexes, which can be a little tricky and may not always work depending on the order/added order of them, I suggest instead looking at the name of each worksheet and delete that way (as mentioned in the comments).
Dim ws as Worksheet
' This next line will suppress the "Confirm Deleting" messagebox
' when you go to delete a worksheet
Application.DisplayAlerts = False
For each ws in ThisWorkbook.Worksheets
If ws.Name <> "Value" and ws.Name <> "Paste" Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
(This assumes the macro is stored in the workbook you want to delete the sheets from. If it's not, perhaps it's stored in Personal.xlsb, then switch ThisWorkbook to ActiveWorkbook or something more specific.)
I have a macro written that clears contents of the active cell row then calls a module to shift the remaining rows up. I am experiencing a long wait time for the macro to finish running. Not sure if this could be written better to execute quicker. The first module is called when a user clicks "Remove Client" on a User Form. Any help would be appreciated. Thank you!
'Called when user clicks Remove Client on User Form
Sub letsgo()
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Sheets("contactunder")
ws.Range("C" & ActiveCell.Row & ":BJ" & ActiveCell.Row).ClearContents
Call shiftmeup
End Sub
Sub shiftmeup()
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Sheets("contactunder") '/// The underhood of my contacts
With ws.Range("D11:BJ392")
For i = .Rows.Count To 1 Step -1
If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete Shift:=xlUp
Next
End With
End Sub
Why not change this line:
ws.Range("C" & ActiveCell.Row & ":BJ" & ActiveCell.Row).ClearContents
To this:
ws.Range("C" & ActiveCell.Row & "BJ" & ActiveCell.Row).EntireRow.Delete
This way you can avoid your second sub all together (or keep this as an occasional cleaner rather run it every time you simply need to delete 1 row.)
If you really do need both subs, a common first step for efficiency is to disable screen updating before entering your loop with Application.ScreenUpdating = False and then re-activate it when your loop ends by changing False to True.
This is the followup to urdearboy's answer...
The issue was in your second function and the static range used. You were deleting all the rows at the end, past your data (up to ~380 extra delete row calls). To fix it you should do two things
Only loop to the last row of data
Limit calls to the front end; put all the cells you want to delete into one range and delete it once
Sub ShiftMeUp()
Dim wb As Workbook
Dim ws As Worksheet
Dim DeleteRowRange As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("contactunder") '/// The underhood of my contacts
For i = 1 To GetLastRow(1, ws)
If IsEmpty(ws.Cells(i, 1)) Then Set DeleteRowRange = MakeUnion(ws.Rows(i), DeleteRowRange)
Next
If Not DeleteRowRange Is Nothing Then DeleteRowRange.EntireRow.Delete Shift:=xlUp
End Sub
I used 2 on my commonly used functions to keep the code clean...
MakeUnion
Public Function MakeUnion(Arg1 As Range, Arg2 As Range) As Range
If Arg1 Is Nothing Then
Set MakeUnion = Arg2
ElseIf Arg2 Is Nothing Then
Set MakeUnion = Arg1
Else
Set MakeUnion = Union(Arg1, Arg2)
End If
End Function
GetLastRow
Public Function GetLastRow(Optional Col As Integer = 1, Optional Sheet As Excel.Worksheet) As Long
If Sheet Is Nothing Then Set Sheet = Application.ActiveSheet
GetLastRow = Sheet.Cells(Sheet.Rows.Count, Col).End(xlUp).Row
End Function