VBA to check if Workbook has multiple Worksheets - vba

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

Related

Check DT Picker Results, copy sheet into new workbook

my VBA skills aren't the best, if someone could help with the following that would be great.
I have a number of sheets in a workbook that has a date record in the cell range E11:E37.
I'm trying to create a reporting function whereby the user completes a date picker userform, Excel runs a search on the above range in all worksheets in this workbook for a date that falls between the DTPicker1/2 results.
For sheets that return a match, copy all those sheets to a new workbook with name ("Name & current Date".xlsx).
Update: I tried reversing the > and <, no change, think i wrapped in Cdate for the DTPicker Values no results, did both, no results....
Update: code now working but doesnt return a value true where dates in range = 01/06/18 - 14/06/18 where DTP1 = 07/06/18 and DTP2 = 16/06/18. But does return true where DTP1 = 04/06/18 and DTP2 = 08/06/18.
Private Sub CommandButton1_Click()
Dim s As Worksheet, wb As Workbook
For Each s In Worksheets
If CBool(Application.CountIfs(s.Range("E11:E37"), ">" &
CDate(DTPicker1.Value), _
s.Range("E11:E37"), "<" &
CDate(DTPicker2.Value))) Then
If wb Is Nothing Then
s.Copy
Set wb = ActiveWorkbook
Else
s.Copy after:=wb.Worksheets(wb.Worksheets.Count)
End If
End If
Next s
If wb Is Nothing Then
MsgBox ("No Records Found")
Else
wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date,
"ddmmyyyy"), _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub
Try this to see if it gets you closer to your goal.
Private Sub CommandButton1_Click()
Dim s As Worksheet, wb as workbook
For Each s In workSheets
If cbool(application.countifs(s.Range("I11:I37"), ">" & cdate(DTPicker1.Value), _
s.Range("I11:I37"), "<" & cdate(DTPicker2.Value))) then
if wb is nothing then
s.copy
set wb = activeworkbook
else
s.copy after:=wb.worksheets(wb.worksheets.count)
end if
end if
next s
if wb is nothing then
MsgBox ("No Records Found")
else
wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date, "ddmmyyyy"), _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub

Active workbook reverting to "thisworkbook" without prompt

Workbooks("The One Sheet.xlsx").Activate
MsgBox ActiveWorkbook.Name 'Returns "The One Sheet.xlsx"
Worksheets("One Sheet").Activate
MsgBox ActiveWorkbook.Name 'Returns "The One Sheet.xlsx"
RwCnt = Application.WorksheetFunction.CountA(Range("A:A"))
MsgBox ActiveWorkbook.Name 'Returns the sheet that contains the code
Does anyone know what could be calling the other workbook into focus?
Not sure what is calling up the other WB into focus. But it is best practice to explicitly define references to workbooks
Sub SheetCode()
Dim wbOne As Workbook
Dim RwCnt As Long
Set wbOne = Workbooks("The One Sheet")
wbOne.Activate
RwCnt = wbOne.ActiveSheet.Range("A" & wbOne.ActiveSheet.Rows.Count).End(xlUp).Row
MsgBox "The last row is " & RwCnt
End Sub
Hope that helps, Caleeco

Excel VBA Loop-Implementation to Clear All Sheets

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

Rename Excel Sheet with VBA Macro

I want to ask about rename the excel sheet, i want to rename the sheet with new name : older name + _v1.
So if my current sheet name is test, then I want the new name test_v1.
I only know the standard vba for rename excel sheet which is renaming excel sheet by the sheet content.
Sub Test()
Dim WS As Worksheet
For Each WS In Sheets
WS.Name = WS.Range("A5")
Next WS
End Sub
The "no frills" options are as follows:
ActiveSheet.Name = "New Name"
and
Sheets("Sheet2").Name = "New Name"
You can also check out recording macros and seeing what code it gives you, it's a great way to start learning some of the more vanilla functions.
This should do it:
WS.Name = WS.Name & "_v1"
Suggest you add handling to test if any of the sheets to be renamed already exist:
Sub Test()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim strErr As String
On Error Resume Next
For Each ws In ActiveWorkbook.Sheets
Set ws1 = Sheets(ws.Name & "_v1")
If ws1 Is Nothing Then
ws.Name = ws.Name & "_v1"
Else
strErr = strErr & ws.Name & "_v1" & vbNewLine
End If
Set ws1 = Nothing
Next
On Error GoTo 0
If Len(strErr) > 0 Then MsgBox strErr, vbOKOnly, "these sheets already existed"
End Sub

compile error: End If without block If (with more issues) [duplicate]

This question already has an answer here:
Compile error: End If without block If
(1 answer)
Closed 7 years ago.
Having an issue with below code. It says compile error when I run it, but I think I got bigger problems than that. What I am trying to accomplish:
Open the most recent "on hand report"
Go back to "Master KB-PFEP" worksheet
If the worksheet has a filter on, clear the filter
Do a VLOOKUP to update the on hand column from the on hand report
Thank you very much for your help
Dim curDate As String, Fname As String
curDate = Format(Date, "yyyy-mm-dd")
Dim wba As Workbook
Fname = "Y:\Consumables\Company\ABC\ABC - Planning & Materials\On Hand Reports\ABC Site\" & curDate & "_INV_R12_ABC_Onhandreport.xlsx"
Set wba = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, Notify:=False)
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.Name Like "*Master KB-PFEP" Then wb.Activate
wb.Worksheets("Master").AutoFilter.Sort.SortFields.Clear
If (Worksheets("Master Data").AutoFilterMode And Worksheets("Master Data").FilterMode) Or Worksheets("Master Data").FilterMode Then
Worksheets("Master Data").ShowAllData
End If
Range("AL8:A" & Cells(Rows.Count, "A").End(xlUp).Row).Formula = "=SUMIF('Inv Report'!C[-36],RC[-36],'Inv Report'!C[-21])"
End If
End Sub
You don't need an End If when the conditional code is on the same line:
If wb.Name Like "*Master KB-PFEP" Then wb.Activate
That means you have an extra one at the bottom. After you fix that, you'll need to add the missing Next somewhere before the End Sub.
I guess what you should have is below (have not checked your R1C1 values):
A new line on wb.Activate
Use FormulaR1C1 instead of Formula
Added Next before End Sub
Sub SO_30042563()
Dim curDate As String, Fname As String
curDate = Format(Date, "yyyy-mm-dd")
Dim wba As Workbook, wb As Workbook
Fname = "Y:\Consumables\Company\ABC\ABC - Planning & Materials\On Hand Reports\ABC Site\" & curDate & "_INV_R12_ABC_Onhandreport.xlsx"
Set wba = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, Notify:=False)
For Each wb In Application.Workbooks
If wb.Name Like "*Master KB-PFEP" Then
wb.Activate
wb.Worksheets("Master").AutoFilter.Sort.SortFields.Clear
If (Worksheets("Master Data").AutoFilterMode And Worksheets("Master Data").FilterMode) Or Worksheets("Master Data").FilterMode Then
Worksheets("Master Data").ShowAllData
End If
Range("AL8:A" & Cells(Rows.Count, "A").End(xlUp).Row).FormulaR1C1 = "=SUMIF('Inv Report'!C[-36],RC[-36],'Inv Report'!C[-21])"
End If
Next
End Sub