Excel VBA Loop-Implementation to Clear All Sheets - vba

I'm attempting to clear all the sheets in a workbook from row 3 down. I've accomplished it like this:
With Sheets("Wizard Sheets Missing in Import")
.Rows("3:" & .Rows.Count).Delete
End With
With Sheets("Import Sheets Missing in Wizard")
.Rows("3:" & .Rows.Count).Delete
End With
With Sheets("Items Missing from Wizard")
.Rows("3:" & .Rows.Count).Delete
End With
With Sheets("Items Missing from Imports")
.Rows("3:" & .Rows.Count).Delete
End With
but would like to implement a loop if possible. I tried this and it only clears the active sheet and none of the other sheets, even though it's being told to loop through the sheets (as far as I'm aware):
For Each vWorksheet In ActiveWorkbook.Sheets
With ActiveSheet
Rows("3:" & .Rows.Count).Delete
End With
Next
Any ideas on how to make a more stream-lined loop for this process?

Option Explicit
Public Sub ClearAllWorksheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.UsedRange.Offset(2).Rows.Delete
Next
End Sub
Clears only rows with data, and doesn't Activate or Select objects
Works only on the file where the code is running specifically - ThisWorkbook
Works only on the Worksheets - doesn't include
Chart Sheets
Macro sheets (Excel 4.0 XLM files)
Dialog sheets (Excel 5.0)

It needs to look more like this
For Each vWorksheet In ActiveWorkbook.Worksheets
vWorksheet.Rows("3:" & vWorksheet.Rows.Count).Delete
Next

Sorry, I pasted the wrong code. Try this one.
Sub DeleteRows()
Dim n As Integer
n = ActiveWorkbook.Worksheets.Count
For x = 1 To n
Sheets(x).Rows(3 & ":" & Sheets(x).Rows.Count).Delete
Next
End Sub

Related

VBA to combine all sheets not working. One sheet does not merge

The following is supposed to take every sheet not named "Combined Reports" and merged into the sheet Combined Reports.
My workbook has 5 worksheets in the following order:
Combined Reports
New Leave Capture
Denial Capture
Open Leave Captuer
RTW Capture
My code captures sheets 3 through 5 but it is not capturing sheet 2. Here is my code if anyone can help
Sub combine_all_Reports()
Dim J As Integer
Dim s As Worksheet
On Error Resume Next
For Each s In ActiveWorkbook.Sheets
If s.Name <> "Combined Reports" Then
Application.GoTo Sheets(s.Name).[B9]
Selection.CurrentRegion.Select
Selection.Copy Destination:=Sheets("Combined Reports"). _
Cells(Rows.Count, 1).End(xlUp)(2)
wksCombinedReports.Cells.EntireColumn.AutoFit
End If
Next
End Sub
You should avoid using Application.GoTo, Selection, and Select and instead use fully qualified objects.
Your For loop code, could be much shorter (and faster), see the code below:
For Each s In ActiveWorkbook.Sheets
If s.Name <> "Combined Reports" Then
' copy >> paste in 1 line
s.Range("B9").CurrentRegion.Copy Destination:=wksCombinedReports.Cells(wksCombinedReports.Rows.Count, 1).End(xlUp)(2)
wksCombinedReports.Cells.EntireColumn.AutoFit
End If
Next
since you already know the sheets name in advance you could code like follows:
Option Explicit
Sub combine_all_Reports()
Dim s As Worksheet
With Worksheets("Combined Reports") ' reference "Combined Reports" sheet
For Each s In Worksheets(Array("New Leave Capture", "Denial Capture", "Open Leave Captuer", "RTW Capture")) ' loop through specific sheets
s.Range("B9").CurrentRegion.copy Destination:=.Cells(.Rows.Count, 1).End(xlUp)(2) ' copy current sheet range B9 current region and paste to referenced sheet (i.e. "Combined Reports")
Next
.UsedRange.EntireColumn.AutoFit ' autofit only once all copy&paste have been made
End With
End Sub

VBA to check if Workbook has multiple Worksheets

I have searched everywhere for an answer to this, but I can't find one. how do I check if there is more than 1 worksheet in Workbook.
To get the number of worksheets within an open workbook, something like:
Sub qwerty()
MsgBox "the number of worksheets in this workbook is: " & ThisWorkbook.Worksheets.Count
End Sub
This will exclude Charts, etc.If you have multiple workbooks open, then something like:
MsgBox "the number of worksheets in this workbook is: " & wb.Worksheets.Count
Where you would Set wb in a prior statement.
To run it from Personal.xlsb then Try this
Public Sub Count_Sheets()
Debug.Print "You Have " & Application.Sheets.count & " Sheets " ' Immediate Window
MsgBox "You Have " & Application.Sheets.count & " Sheets "
End Sub
Or use ActiveWorkbook.Sheets.count
This is what ended up working best for me. It incorporates multiple answers in here to do what it does.
Sub CountSheets()
Dim mainWB As Workbook
Dim mainWS As Worksheet
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets(1)
If mainWB.Sheets.Count > 1 Then MsgBox "There is more than one worksheet in this Excel file."
End Sub

Repeat a sub command

I want to move sheets to a new workbook and save it as a new workbook with the sheet name. I have got that part, but I want to repeat it until all the sheets are moved from the main workbook.
the code I used is below:
Sub MoveToNew()
'Move the active sheet to a new Workbook.
Activesheet.Move
MName = Activesheet.Name & ".xls"
MDir = ActiveWorkbook.Path
ActiveWorkbook.SaveAs Filename:="C:\Users\DICS-IN\Desktop\Check\" & MName
ActiveWorkbook.Save
ActiveWorkbook.Close
It works until this but I want the same thing to be repeated until all the sheets are moved and saved separately from the main sheet.
I found Dim as Integer and etc but couldn't do it.
loop through all sheets using a For Each ... Next loop
Example:
Sub test()
Dim S As Worksheet
' loop through all worksheets
For Each S In ActiveWorkbook.Worksheets
Debug.Print S.Name
' do something with S
Next S
End Sub

Change one sheet's name when another is changed

I am working on a dashboard/stats for employees at my company, and I've run into a bit of a hiccup with one of my codes. Here's a bit of background to start
Each employee has 2 sheets with their different stats.
The first sheet is always visible and has a macro that will un-hide and activate the 2nd sheet (so that the workbook doesn't get too unmanageable.) When you click off the 2nd sheet, I have a macro that will hide it (it uses workbook_Sheetdeactivate to close the sheet if it has properties related to the 2nd sheet)
The first sheet's tab-name is added to a cell (in my case range("A62")), with the formula "=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255)".
I then make that cell equal to range("A1") on the second sheet. What I want is for the the name of the 2nd sheet to equal range("A1") & " Achievements", so that the 2nd sheet can be referenced in my macros by the first sheet. (Ex: if sheet1 is "Bobby", sheet2 is "Bobby Achievements")
I didn't have trouble writing the macro itself, but I don't know which sub would be best to use so that the macro is activated at the right time. Is there a way to have the macro run whenever a sheetname is changed in the workbook?
Here's the code:
dim ws as worksheet
'Sorting through each sheet to find "Achievement Sheets"
For Each ws in Workbook
If ws.range("W1").Value = "Achievement Lists" Then
ws.name = ws.Range("A1") & " Achievements"
End if
Next ws
It may be a bit crude, but you could simply use the 'Calculate' event on the second worksheet object to update its own name.
Private Sub Worksheet_Calculate()
If Range("A1") & " Achievements" <> Me.Name Then
Me.Name = Range("A1") & " Achievements"
End If
End Sub
or use the 'SheetCalculate event in the workbook object:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
On Error Resume Next
If Sh.Range("W1").Value = "Achievement Lists" Then
If Sh.Range("A1").Value & " Achievements" <> Sh.Name Then
Sh.Name = Sh.Range("A1") & " Achievements"
End If
End If
End Sub

VBA Code to cycle through worksheets starting with a specific sheet (index 3)

I need to cycle through sheets of index 3 tip last sheet and run a code. I tried something like this but its doesn't work.
If (ws.sheetIndex > 2) Then
With ws
'code goes here
End With
End If
I did a search but don't find a solution to this problem. Help would be much appreciated.
I also tried:
Dim i As Long, lr As Long
Dim ws As Worksheet
Windows("Book1").Activate
With ActiveWorkbook
Set ws = .Worksheets("index")
For i = 3 To 10
'code goes here
Next i
End With
You can try the following, which iterates over all worksheets in your workbook and only "acts" for worksheets with index 3 or above.
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Index > 2 Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(1, 1).Value = "hi"
End If
Next
Note that this doesn't put a hard limit on the number of sheets you have (10 or whatever), as it will work with any number of worksheets in your active workbook.
EDIT
If you want the code to run on worksheets with names "Sheet" + i (where i is an index number from 3 onwards), then the following should help:
Dim sheet As Worksheet
Dim i As Long
For i = 3 To ActiveWorkbook.Worksheets.Count
Set sheet = ActiveWorkbook.Worksheets(i)
If sheet.Name = "Sheet" & i Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(2, 2).Value = "hi"
End If
Next i
Of course, this means that the names of your worksheets need to always follow this pattern, so it's not best practice. However, if you're sure the names are going to stay like this, then it should work well for you.
Try excluding first and second sheet using name:
Public Sub Sheets3andUp()
Dim ws As Worksheet
Dim nameOfSheet1 As String
Dim nameOfSheet2 As String
nameOfSheet1 = "Sheet1"
nameOfSheet2 = "Sheet2"
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> nameOfSheet1 And ws.Name <> nameOfSheet2 Then
'Code goes here
Debug.Print ws.Name
End If
Next ws
End Sub
Note that the user can reorder the sheets in the Worksheets Collection, so it is better to refer to the sheets by CodeName (which the user cannot change), and exclude by CodeName the sheets to be skipped, as here:
Public Sub TestLoop()
On Error GoTo ErrHandler
Dim ws As Worksheet, s As String
For Each ws In Worksheets
If ws.CodeName <> "Sheet2" Then
s = s & vbNewLine & ws.CodeName
End If
Next ws
s = "WorksheetList (except Sheet2:" & vbNewLine & vbNewLine & s
MsgBox s, vbOKOnly, "Test"
EndSUb:
Exit Sub
ErrHandler:
Resume EndSUb
End Sub
If I drag Sheet 3 to precede Sheet1, the MsgBox outputs:
WorksheetList (except Sheet2:
Sheet3
Sheet1