I am trying to collect data from multiple workbooks by checking the worksheet names.
However when i run my code to check the worksheetname(which is Raw Data), i am getting a false result. The code is returning only Sheet1 and Sheet2.
Below is the code:
Function WorksheetRAWExists(wsName As String) As Boolean
Dim ws As Worksheet
Dim ret As Boolean
ret = False
wsName = UCase(wsName)
For Each ws In ThisWorkbook.Sheets
If UCase(ws.Name) = "RAW DATA" Then
ret = True
Exit For
End If
Next
WorksheetRAWExists = ret
End Function
This happens because you loop through "ThisWorkbook" in your for-each, which always checks the worksheet collection in the workbook you're running the VBA code from.
If you're looking to loop through all sheets in all open workbooks then you could do something like so:
Sub test()
Dim wbk As Workbook, ws As Worksheet
For Each wbk In Workbooks
For Each ws In wbk.Worksheets
MsgBox ws.Name
Next ws
Next wbk
End Sub
Edit:
You could also pass the workbook name or index (or the workbook reference itself) to your function and check that specific reference in the workbook collection, in case looping through all open workbooks isn't what you want.
Related
I am currently working on a VBA macro, that takes data from a Worksheet and copies it to another.
If the destination Worksheet does not exist it should create it and than write the data from my array.
Problem:
I have a function to test if the worksheet already exists.
If it is the case my macro will successfully write the data i want. But if the worksheet doesnt exist VBA is displaying the error you can see below.
In the list Workbook.Worksheets is no Sheet named like this but I get that error anyway.
Here is my relevant code:
(If something is missing for understanding the problem I can fill in the missing part in too)
Function sheetExists(sheetToFind As String) As Boolean
Dim Sheet As Worksheet
For Each Sheet In Worksheets
If sheetToFind = Sheet.Name Then
sheetExists = True
Exit Function
End If
Next Sheet
sheetExists = False
End Function
In my main Sub I used this code:
If sheetExists("SheetName") = False Then
Dim newSheet As Worksheet
With ThisWorkbook
.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "SheetName"
End With
End If
The exact error:
1004 Cannot rename a sheet to the same name as another sheet, a reference object library, or a workbook referenced by Visual Basic
First it was executing successfully but after I deleted the sheet manually the error occurred.
Thanks for any help :)
Specify in which workbook to look at:
For Each Sheet In ThisWorkbook.Sheets
also not that it has to be Sheets and not Worksheets, because Worksheets only contains worksheets but Sheets also contains charts, etc. So we have to check these names too!
(Sheet then has to be Dim Sheet As Object)
You can make your function more flexible:
Function sheetExists(sheetToFind As String, Optional InWorkbook As Workbook) As Boolean
If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook
Dim Sheet As Object
For Each Sheet In InWorkbook.Sheets
If sheetToFind = Sheet.Name Then
sheetExists = True
Exit Function
End If
Next Sheet
sheetExists = False
End Function
so you can call it:
sheetExists("SheetName") to use ThisWorkbook by default, or
sheetExists("SheetName", Workbooks("MyWorkbook")) to specify a specific workbook.
Alternatively you can use
Function sheetExists(sheetToFind As String, Optional InWorkbook As Workbook) As Boolean
If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook
On Error Resume Next
sheetExists = Not InWorkbook.Sheets(sheetToFind) Is Nothing
End Function
which can be a bit faster if there are many sheets in a workbook.
I have a workbook with a master sheet for school report cards. I have a macro applied to a button for exporting information from the master sheet to separate, newly-generated sheets in the same workbook. A1:C71 is the template and goes to every new sheet, and the following columns of info, from D1:71 to Q1:71, each appear in separate sheets (always in D1:71).
Here's the screenshot (http://imgur.com/a/ZDOVb), and here's the code:
`Option Explicit
Sub parse_data()
Dim studsSht As Worksheet
Dim cell As Range
Dim stud As Variant
Set studsSht = Worksheets("Input")
With CreateObject("Scripting.Dictionary")
For Each cell In studsSht.Range("D7:Q7").SpecialCells(xlCellTypeConstants, xlTextValues)
.Item(cell.Value) = .Item(cell.Value) & cell.EntireColumn.Address(False, False) & ","
Next
For Each stud In .keys
Intersect(studsSht.UsedRange, studsSht.Range(Left(.Item(stud), Len(.Item(stud)) - 1))).Copy Destination:=GetSheet(CStr(stud)).Range("D1")
Next
End With
studsSht.Activate
End Sub
Function GetSheet(shtName As String) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
GetSheet.Name = shtName
Sheets("Input").Range("A1:C71").Copy
GetSheet.Range("A1:D71").PasteSpecial xlAll
GetSheet.Range("A1:B71").EntireColumn.ColumnWidth = 17.57
GetSheet.Range("C1:C71").EntireColumn.ColumnWidth = 54.14
GetSheet.Range("D1:D71").EntireColumn.ColumnWidth = 22
End If
End Function`
I would now like to create a separate button to split the sheets into separate workbooks so that the master sheet can be kept for record keeping and the individual workbooks can be shared with parents online (without divulging the info of any kid to parents other than their own). I would like the workbooks to be saved with the existing name of the sheet, and wonder if there's a way to have the new workbooks automatically saved in the same folder as the original workbook without having to input a path name? (It does not share the same filename as any of the sheets).
I tried finding other code and modifying it, but I just get single blank workbooks and I need as many as have been generated (preferably full of data!), which varies depending on the class size. Here's the pathetic attempt:
`Sub split_Reports()
Dim splitPath As String
Dim w As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim lastr As Long
Dim wbkName As String
Dim wksName As String
Set wsh = ThisWorkbook.Worksheets(1)
splitPath = "G:\splitWb\"
Set w = Workbooks.Add
For i = 1 To lastr
wbkName = ws
w.Worksheets.Add(After:=w.Worksheets(Worksheets.Count)).Name = ws
w.SaveAs splitPath
w.Close
Set w = Workbooks.Add
Next i
End Sub`
I have learned so much, and yet I know so little.
Maybe this will start you off, just some simple code to save each sheet as a new workbook. You would probably need some check that the sheet name is a valid file name.
Sub x()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Copy
ActiveWorkbook.Close SaveChanges:=True, Filename:=ws.Name & ".xlsx"
Next ws
End Sub
I am trying to create a copy of a large macro enabled (xlsm) file in xlsx format.
Sub Button1_Click()
Dim wb As Workbook
Set wb = Workbooks.Open("C:\original.xlsm")
Dim mySheetList() As String
ReDim mySheetList(0 To (ThisWorkbook.Sheets.Count) - 1)
Dim a As Integer
a = 0
For Each ws In ActiveWorkbook.Worksheets
mySheetList(a) = ws.Name
a = a + 1
Next ws
'actually save
Worksheets(mySheetList).Copy
ActiveWorkbook.SaveAs Filename:="ORIGINAL_COPY.xlsx" 'default ext
wb.Close
End Sub
I am getting subscript out of range error at following line:
mySheetList(a) = ws.Name
You are sizing the array with ThisWorkbook.Sheets but the loop use ActiveWorkbook.Worksheets. You need the same reference to avoid issues when multiple workbooks are opened.
You're using 4 different references to workbooks:
wb, ThisWorkbook and ActiveWorkbook are not necessarily the same thing. Furthermore, when you use Worksheets without prefixing it with a workbook reference, you're implicitly referencing the Activeworkbook. And, when you use Worksheets.Copy without any arguments, you're implictly creating a new workbook.
Currently, if ThisWorkbook has fewer sheets than original.xlsm, then your array will not be large enough to accommodate indexes larger than the count of sheets in ThisWorkbook. That is what is causing your out of bounds error.
I've adjusted the code. This will open the XLSM, copy the sheets, save the new XLSX workbook, and close the original XLSM, leaving the new XLSX workbook open.
Sub Button1_Click()
Dim wbOriginal As Workbook
Dim wbOutput As Workbook
Set wbOriginal = Workbooks.Open("C:\original.xlsm")
Dim mySheetList() As String
ReDim mySheetList(0 To (wbOriginal.Sheets.Count) - 1)
Dim a As Integer
a = 0
For Each ws In wbOriginal.Worksheets
mySheetList(a) = ws.Name
a = a + 1
Next ws
'Unfortunately, Worksheets.Copy isn't a function, so it doesn't
'return the workbook that it creates, so we have to execute the
'copy, then find the activeworkbook
Worksheets(mySheetList).Copy
Set wbOutput = ActiveWorkbook
'actually save
wbOutput.SaveAs Filename:="ORIGINAL_COPY.xlsx" 'default ext
wbOriginal.Close
End Sub
Why bother with all that looping?
Sub MM()
Dim sourceWB As Excel.Workbook
Set sourceWB = Workbooks.Open("C:\Original.xlsm")
sourceWB.SaveAs "C:\ORIGINAL_COPY.xlsx", FileFormat:=xlOpenXMLWorkook
sourceWB.Close False '// Optional
End Sub
The .SaveAs() method would be far more effective.
As mentioned in other answers, your issue seems to be with wb, ActiveWorkbook and ThisWorkbook being used interchangeably when they are actually different things.
wb is a workbook object that has been set to "C:\original.xlsm". It will always refer to that workbook unless you close the workbook, empty the object, or assign a new object to it.
ActiveWorkbook refers to the workbook that is currently active in Excel's forefront window. (i.e. The workbook you can see on your screen)
ThisWorkbook refers to the workbook in which the currently executing code belongs to. To quickly explain the difference:
Workbook A is the only workbook open, and has some code in to open another workbook (let's call it Workbook B).
At the moment, Workbook A is the ActiveWorkbook.
The code in workbook A starts running, workbook A is now the ActiveWorkbook and ThisWorkbook (because the running codes resides in this workbook)
The code opens Workbook B, which naturally opens in the forefront of Excel. Now Workbook B is the ActiveWorkbook and Workbook A is still the ThisWorkbook
Hopefully that clears it up a bit for you...
This seems like such a simple request, but I can't seem to find any answers online.
I have two open workbooks (lets say A and B). All I want to do is run a macro that I have created in Workbook B and run it (by click a shape that I've assigned a macro to) through Workbook A, but the macro running in Workbook B
The macro I created for Workbook B is...
Sub HistoricalDataShift()
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate'
Rows("18:1000").Select
Selection.Copy
Range("A19").Select
ActiveSheet.Paste
Rows("15:15").Select
Selection.Copy
Range("A18").Select
ActiveSheet.Paste
Next ws
End Sub
Then I created a second macro in Workbook B that has...
Sub ApplicationRun()
Application.Run ("WorkbookB.xlsm!HistoricalDataShift")
End Sub
But each time I try the macro keeps running in Workbook A.
If I could get a helping hand that would be appreciated.
All you need to do is rewrite HistoricalDataShift to operate on itself. It should work just fine then.
Sub HistoricalDataShift()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
For Each ws In wb.Worksheets
ws.Activate '
ws.Rows("18:1000").Select
Selection.Copy
ws.Range("A19").Select
ActiveSheet.Paste
ws.Rows("15:15").Select
Selection.Copy
ws.Range("A18").Select
ActiveSheet.Paste
Next ws
End Sub
Also to make your code work better, you can do this:
Sub HistoricalDataShift()
Dim wb As Workbook
Set wb = ThisWorkbook
wb.Activate
Dim ws As Worksheet
For Each ws In wb.Worksheets
Call ws.Rows("18:1000").Copy(ws.Range("A19"))
Call ws.Rows("15:15").Copy(ws.Range("A18"))
Next ws
End Sub
Try declaring your workbook object?
Dim wkbkA as workbook
set wkbkA = 'directory here
then run your code in a With... End With
With wkbkA
.range('etc.........
End With
In this short example, we assume that WorkbookB.xlsm is initially the only open workbook and hosts this macro:
Sub HistoricalDataShift()
Dim wkbB As Workbook
Dim wkbA As Workbook
Set wkbB = ThisWorkbook
Workbooks.Open Filename:="WorkbookA"
Set wkbA = ActiveWorkbook
wkbA.Sheets(1).Range("B9").Value = "whatever"
End Sub
You can use Worksheets("<worksheetname>")
e.g. Worksheets("A").Activate
or cv = Worksheets(Worksheet).Cells(DataSeriesEnd, rc_index)
where Worksheet holds the sheet name.
etc.
This snippet will go through the entire collection of worksheets, where w is the current worksheet name :-
For Each w In Worksheets
.......
Next w
Basically am trying to copy a sheet from one workbook to another. While doing that i get an error called subscript out of range.
Sub cp()
Dim ws As Worksheet, wb As Workbook
'Target workbook
Set wb = Workbooks("Desktop:\Book2.xlsb")
'Source workbook
For Each ws In Workbooks("Desktop:\Book1.xlsb")
ws.copy After:=wb.Sheets(wb.Sheets.Count)
Next ws
End Sub
If the file is already open, then just do:
Set wb = Workbooks("Book2.xlsb")
And likewise,
For each ws in Workbooks("Book1.xlsb").Worksheets
Note also you need to indicate the .Worksheets collection in the above statement. For each ws in Workbooks("Book1.xlsb") will not work, even though a workbook contains worksheets, there is no implied iteration like this, you need to specify which collection you're looping over.