Start empty Excel workbook without any worksheets - excel

Creating a new Excel workbook as in:
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Set xl = New Excel.Application
xl.Visible = False
Set wb = xl.Workbooks.Add
Is there an easy way to stop Excel automatically creating Sheet1, Sheet2, Sheet3?
I can always delete these unwanted sheets afterwards but that feels like a clunky solution.

xl.SheetsInNewWorkbook = 1
More Information on MSDN (Scroll down to Add method as it applies to the Workbooks object.)
Full Code:
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim restoreSheetsInNewWorkbook As Long
Set xl = New Excel.Application
restoreSheetsInNewWorkbook = xl.SheetsInNewWorkbook
xl.SheetsInNewWorkbook = 1
Set wb = xl.Workbooks.Add
xl.SheetsInNewWorkbook = restoreSheetsInNewWorkbook 'or just set it to 3'

Or you can:
Excel 2003
Tools>Options>General Tab and change the "Sheets in new workbook" to 1
Excel 2007
Office Button>Excel Options>Popular Section>When creating new workbooks...>Include this many sheets>1

Can't create one without any sheets (to the best of my knowledge), but you can create a workbook with a single sheet without messing around with the user's settings.
dim wb as Workbook
Set wb = xl.Workbooks.Add(xlWBATWorksheet)

Sub DeleteSheets()
Dim DeleteSheet As Variant
Dim ws As Worksheet
DeleteSheet = Array("Sheet1", "Sheet2", "Sheet3")
Application.DisplayAlerts = False
For Each ws In Worksheets
If IsInArray(ws.Name, DeleteSheet) Then ws.Delete
Next
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i As Integer
Dim Ret As Boolean
Ret = False
For i = LBound(arr) To UBound(arr)
If VBA.UCase(stringToBeFound) = VBA.UCase(arr(i)) Then
Ret = True
Exit For
End If
Next i
IsInArray = Ret
End Function

Related

Excel VB Workbook_Open() only works manually

I have a workbook that open another workbook and copies a range of data over. After that it does some data collection and sends an email. The issue I have is that the Workbook_Open() function to autorun this when the workbook is open does not work correctly. If I have the original workbook open and run it from the VB editor all works fine. If however, I let it run automatically it hangs and says the "Select method of the Worksheet class has failed"
Private Sub Workbook_Open()
Call send_Mail
End Sub
Private Sub send_Mail()
Dim Mail As CDO.Message
Set Mail = New CDO.Message
Dim strFilename As String: strFilename = "S:\Office\Requisition Logs\FY22\FY 2022.xlsx"
Dim wb2 As Workbook
Set wb2 = Workbooks.Open(Filename:=strFilename)
Dim vals As Variant
'Store the value in a variable:
vals = wb2.Sheets("FY2022 Log").Range("A2:AJ500").Value
'Close wb2:
wb2.Close savechanges:=False
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
'Use the variable to assign a value to the other file/sheet:
wb1.Sheets("FY2022 Log").Range("A2:AJ500").Value = vals
wb1.Sheets("FY2022 Log").Select
Dim x As Integer
x = 1
Dim lastRow As Integer
Dim lastCol As Integer
Dim startRow As Integer
Dim numRows As Integer
startRow = 2
.............................
I do have the Workbook_Open() in the Workbook tab of the ThisWorkbook

VBA - Set the correct Workbook taken from a Collection

New to VBA here.
I'm trying to recover the reference of a Excel Workbook from a Collection and SOMETIMES I end with the error 91 "Object variable or With block variable not set"
Using the function "apriData()" I should have as a result a collection where:
coll[1] = reference to the WB opened from an excel file;
coll[2] = reference to the appExcell.
Function apriData() As Collection
Dim appExcel As Application
Dim coll As Collection
Set coll = New Collection
Dim wb As Workbook
Dim wsData As Worksheet
Dim ws As Worksheet
Dim i As Integer
'create new excel application object
Set appExcel = New Application
'set the applications visible property to false
appExcel.Visible = False
'open the workbook with data
On Error GoTo Error1
Set wb = appExcel.Workbooks.Open("PATH OF THE EXCEL FILE TO SAVE THE WB - CENSORED")
On Error GoTo Error2
MsgBox ("DATA aperto")
coll.Add wb
coll.Add appExcel
Set apriData = coll
Exit Function
Error1:
'close the application
appExcel.Quit
Exit Function
Error2:
'close the workbooks
wb.Close
'close the application
appExcel.Quit
Exit Function
End Function
This function is used in my formatta() method to save the collection retrived from the apriData() and use the selected WB.
Here it's the code:
Sub formatta()
Dim collectionData As Collection
Set collectionData = New Collection
Dim wb As Workbook
Dim wbData As Workbook
Dim app As Application
Dim ws As Worksheet
Dim sheetCount As Integer
Dim i As Integer
Dim target As Range
Set wb = ActiveWorkbook
sheetCount = wb.Worksheets.Count
For i = 1 To sheetCount
If Sheets(i).Name = "CE" Then
Sheets(i).Cells.Clear
End If
Next i
Set ws = wb.Worksheets(2)
ws.Name = "CE"
Set target = ws.Range("A1")
Set collectionData = apriData
Set wbData = collectionData(1)
Set app = collectionData(2)
creaGriglia wbData
popolaGriglia wbData
'close the workbooks
wbData.Close
'close the application
app.Quit
End Sub
I think the problem could be the "Set collectionData = apriData" not referencing the correct WB value.
Thank you for every support.

how to write a code in vba so each time a function call its create a different sheet in a workbook

Public Sub text1(st As String)
Dim oXL As Object ' Excel application
Dim oBook As Object ' Excel workbook
Dim oSheet As Object ' Excel Worksheet
Dim i As Integer
'Start Excel and create a new workbook
Set oXL = CreateObject("Excel.application")
Set oBook = oXL.Workbooks.Open("E:\karan.xlsx")
Set ws = oBook.Sheets.Add
oBook.activesheet.Name = st
ws.Activate
To what I understand you, you would like to add a workbook when your function is called. In such a case you could use this:
Sub AddWorkbook()
Sheets.Add After:=Sheets(Sheets.Count)
End Sub
If you additionally want to add a name:
Private Sub AddWorkbookWithName(workbookName As String)
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = workbookName
End Sub
Sub AddWorkbook()
AddWorkbookWithName ("MyWorkbookName")
End Sub

Why does Worksheet.Copy not return a reference to the new workbook created

I have some code where wb is an existing multi-worksheet workbook. If I copy one of the sheets "Overview" a new workbook is created - so why does the following error saying "object required"?:
Dim wbCopy As Excel.Workbook
Set wbCopy = wb.Sheets("Overview").Copy
The Worksheet.Copy method doesn't return a reference to the new Workbook. You might use a Worksheet reference instead:
Dim wsCopy As Excel.Worksheet 'changed from wb to wsCopy
As you know, if you don't supply either the After or Before argument it copies to a new Workbook. Copying within the same workbook would use this code:
Set wsCopy = wb.Worksheets("Overview")
wsCopy.Copy After:= wb.Worksheets(1) 'or Before:=
If you want to copy the sheet to a new workbook, and retain a reference to it, then this needs to be done in stages:
Dim wbNew As Excel.Workbook
Dim wsCopied As Excel.Worksheet
Set wbNew = Workbooks.Add
wsCopy.Copy before:=wbNew.Worksheets(1)
Set wsCopied = wbNew.Worksheets(1)
If you only need to keep a reference to the new workbook then just omit the last line (and the variable declaration for wsCopied).
This is one of the few occasions you have to use one of the Active* objects
wb.Sheets("Overview").Copy
Set wbCopy = ActiveWorkbook
The worksheets copy method appears to return a boolean value rather than a workbook object. To set a reference to the workbook you can use the following.
Sub wbcopy()
Dim wbcopy As Excel.Workbook
Dim wbIndex As Excel.Workbook
Dim sArray() As String
Dim iIndex As Integer
Dim bfound As Boolean
Dim wb As Workbook
Set wb = ThisWorkbook
ReDim sArray(Workbooks.Count)
'Find the names of all the current workbooks
For Each wbIndex In Workbooks
sArray(iIndex) = wbIndex.FullName
Next wbIndex
'Copy the sheet to a new workbook
wb.Sheets("Overview").Copy
'Find the sheet with the new name
For Each wbIndex In Workbooks
bfound = False
For iIndex = LBound(sArray) To UBound(sArray)
If wbIndex.FullName = sArray(iIndex) Then
bfound = True
Exit For
End If
Next iIndex
If Not bfound Then
Set wbcopy = wbIndex
Exit For
End If
Next wbIndex
End Sub
I ran into the same thing today. To me the active* objects is too vague so I looked for a way to reliably determine the sheet object.
Just if anyone's looking for this, here's for the files:
dim sws, tws as worksheet
set sws = thisworkbook.sheets("source")
sws.copy before:=sws
set tws = sws.previous
That does the job
rn43x

Referencing temporary, unsaved workbook when copying worksheets

I have worksheets I want to copy to a new, temporary workbook -- without saving it.
Worksheet.Copy copies the worksheet to a new, unnamed'ish (Book1, Book2, Book3, etc) workbook. I want all sheets to be copied to the same workbook.
For all worksheets after the first, I have tried using Worksheet.Copy After:=xlWb.Sheets(1), but I do not know how to reference the newly created workbook when setting the xlWb workbook-object. I keep receiving
run-time error 9, 'Subscript out of range'.
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWbOld As String
Dim xlWs As Excel.Worksheet
Dim xlWbNew As Excel.Workbook
Dim xlWsOld As Excel.Worksheet
Dim xlRng As Excel.Range
Dim xlRngOld As Excel.Range
xlWbOld = ActiveWorkbook.Name
Set xlApp = New Excel.Application
xlApp.Visible = True '*** Quite Important to set Excel.Visible,_
'Otherwise user wouldn't see the application's running _
'even though it would run as background
xlApp.Application.ScreenUpdating = False
Set xlWb = xlApp.Workbooks.Add 'Create a new Workbook
Set xlWs = xlWb.Worksheets.Add
And this is where the worksheets should be copied:
Select Case strRptType
Case "DAILY"
xlWs.Name = "1-Daily Price"
'Check the last column and the last row
lLastRow = oBasic.GetLast(, "DailyRpt", False, "A")
iLastCol = oBasic.GetLast(, "DailyRpt", True, 4)
Set xlRngOld = wksDailyRpt.Range(wksDailyRpt.Cells(4, 1), wksDailyRpt.Cells(lLastRow, iLastCol))
Application.ScreenUpdating = True
xlRngOld.Copy
Set xlRng = xlWs.Cells(1, 1)
xlRng.PasteSpecial Paste:=xlPasteValues
xlWs.Columns.AutoFit
For Each xlWsOld In ActiveWorkbook.Worksheets
If xlWsOld.Name = "ForwardPrices" Or xlWsOld.Name = "ForwardVolatilities" _
Or xlWsOld.Name = "ForwardReturns" Or xlWsOld.Name = "ForwardCorrelations" Then
Sheets(xlWsOld.Name).Copy After:=Workbooks(xlWb).Sheets(1)
End If
Next xlWsOld
End Select
This little macro goes through all the sheets of all the open workbooks, and copies them after the current sheet.
Sub GatherAllSheets()
Dim Wb As Workbook, Sh As Worksheet
For Each Wb In Workbooks
If Not Wb Is ThisWorkbook Then
For Each Sh In Wb.Worksheets
Sh.Copy after:=ActiveSheet
Next Sh
End If
Next Wb
End Sub
Is this what you need?
Or you need to copy the content of the sheets on the same sheet?
I solved it with the following:
For Each xlWsOld In ActiveWorkbook.Worksheets
If xlWsOld.Name = "ForwardPrices" Or xlWsOld.Name = "ForwardVolatilities" _
Or xlWsOld.Name = "ForwardReturns" Or xlWsOld.Name = "ForwardCorrelations" Then
Set xlRngOld = Nothing
Set xlWsForwards = xlWb.Worksheets.Add
lLastRow = oBasic.GetLast(, xlWsOld.Name, False, "A")
iLastCol = oBasic.GetLast(, xlWsOld.Name, True, 1)
Set xlRngOld = xlWsOld.Range(xlWsOld.Cells(1, 1), xlWsOld.Cells(lLastRow, iLastCol))
xlWsForwards.Name = xlWsOld.Name
xlRngOld.Copy
Set xlRngForwards = xlWsForwards.Cells(1, 1)
xlRngForwards.PasteSpecial Paste:=xlPasteValues
xlWsForwards.Columns.AutoFit
xlWsForwards.Cells(1, 1).Select
Set xlWsForwards = Nothing
End If
Next xlWsOld
skip creating the new workbook, and copy all the sheets in one go.
xlWbOld.Sheets(Array("ForwardPrices", "ForwardVolatilities", "ForwardReturns", "ForwardCorrelations")).Copy
Set xlWb = ActiveWorkbook
this way copying creates the new workbook which becomes ActiveWorkbook. then you can assign it to a workbook object, and reference it by that name later on

Resources