I am currently using Excel 2011 on Mac, and I am trying to pull data using a QueryTable, but I am forced to have to import the entire table. I am currently pasting the entire table onto a hidden sheet, then using a formula to pull data from the specific cell. To show you what I mean, Here is a sample:
Sub Yield()
Dim URL As String
Dim qt as QueryTable
Dim hs As Worksheet
Set hs = Worksheets("Hidden Sheet")
Set ws = Worksheets ("Managed Equity Portfolios")
URL = "http://www.nasdaq.com/symbol/spy"
Sheets("Hidden Sheet").Visible = True
Set qt = hs.QueryTables.Add( _
Connections:= "URL;" & URL, _
Destination:= hs.Range("A1"))
qt.RefreshStyle = xlOverwriteCells = True
qt.BackgroundQuery = True
qt.SaveData = True
qt.Refresh Background Query:= False
'I am using the same parameters here as my other code, honestly not
'sure why a lot of it is on here, but I kept it because it works.
Worksheets("Hidden Sheet").Visible = False
End Sub
Currently, the information I need is being pasted into the Hidden Sheet in cell B42. I made it so the cell that I want the information ='Hidden Sheet!'B42 but this doesn't seem very efficient. Is there any way I could have just the cell B42 be put into Excel?
I'll be on here to clear up any questions, thank you so much!
So I have a worksheet that generates a chart type of thing using information on 2 other worksheets. On It I have an extract button which should copy the entire workbook into a new workbook whilst making the sheets where the data is pulled from invisible to the user. My issue is, the chart worksheet has other features which require macros to be run, for example buttons that hide some of it etc. The issue is I cannot find whether its actually possible to copy through macros from a workbook into the new copied workbook? Anyone have an answer to this and if so, how would you do this? Here is the code I currently have which copies the workbook into a new workbook:
Sub EWbtn()
Dim OriginalWB As Workbook, NewCRCWB As Workbook
Set OriginalWB = ThisWorkbook
Set NewCRCWB = Workbooks.Add
OriginalWB.Sheets("Generator").Copy Before:=NewCRCWB.Sheets("Sheet1")
OriginalWB.Sheets("Module Part Number Tracker").Copy Before:=NewCRCWB.Sheets("Generator")
OriginalWB.Sheets("CRC").Copy Before:=NewCRCWB.Sheets("Module Part Number Tracker")
Application.DisplayAlerts = False
NewCRCWB.Worksheets("Generator").Visible = False
NewCRCWB.Worksheets("Module Part Number Tracker").Visible = False
NewCRCWB.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
End Sub
I'd take a copy of the original file and delete/hide sheets from that.
All code is copied over as part of the save.
Sub Test()
Dim wrkBk As Workbook
Dim sCopyFileName As String
Dim wrkSht As Worksheet
sCopyFileName = "C:\MyFolderPaths\Book2.xlsm"
'Create copy of original file and open it.
ThisWorkbook.SaveCopyAs (sCopyFileName)
Set wrkBk = Workbooks.Open(sCopyFileName)
'wrkbk.Worksheets does not include Chart sheets.
'wrkbk.Sheets would take into account all the types of sheet available.
For Each wrkSht In wrkBk.Worksheets
Select Case wrkSht.Name
Case "Generator", "Module Part Number Tracker"
wrkSht.Visible = xlSheetVeryHidden
Case "CRC"
'Do nothing, this sheet is left visible.
Case Else
Application.DisplayAlerts = False
wrkSht.Delete
Application.DisplayAlerts = True
End Select
Next wrkSht
wrkBk.Close SaveChanges:=True
End Sub
I managed to find an answer to my question.. This code works fine however you need to add "Microsoft Visual Basic for Applications Extensibility 5.x" as a reference via Tools -> References. Here is the code:
Dim src As CodeModule, dest As CodeModule
Set src = ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set dest = Workbooks("Book3").VBProject.VBComponents("ThisWorkbook") _
.CodeModule
dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)
Credit: Copy VBA code from a Sheet in one workbook to another?
I am new to VBA (and Excel for that matter) so please keep that in mind when reviewing my code. This is also my first post here!
I am trying to complete and refine my file, but I have run into a error that I cannot seem to fix or even understand. I have searched this site (and many others) and found many people with this same error, but their resolutions are irrelevant and/or don't solve my problem.
This is the error I receive:
"Automation Error. The object invoked has disconnected from its clients."
If I click debug, end, or help, Excel crashes and (sometimes) reopens an recovered file. SO frustrating!
I have managed to locate the line of code that causes this:
templateSheet.Copy After:=indexSheet
templateSheet and indexSheet are defined references to specific worksheets
The gist of what happens within this part of my file:
I've created a userform and a form control button. The button shows the userform. The userform has two fields asking the user to enter names. The code (all in the userform) checks all worksheet names.
If the name exists, it tells the user to choose a different name.
If the name doesn't exist, a hidden template sheet (templateSheet) is copied and pasted after the homepage sheet (indexSheet) and renamed based on the user input.
A table on the homepage gets a new row and a hyperlink to the new sheet is added.
There is additional code that adds values to cells on multiple sheets and formats that text.
All of this works perfectly for 21 runs. On the 22nd run, without fail, the automation error pops up and Excel crashes.
This happens on windows with Excel 2010, 2011, and 2016 (I've yet to test other versions on Excel) on a range of Windows versions. Bizzarly, the file works PERFECTLY on my 2013 MacBook pro with Excel 2011.. no errors at all.
The code I provide at the end of this post is the majority of the code within the file. At first, I thought it may be a memory issue but I think this is a pretty simple file, something excel and my desktop should be able to handle.
What I've done so far to try to fix it:
Option explicit
Keep templateSheet visible at all times
Create a separate Excel template file and call that from the userform
Changed .Activate and .Select to defined ranges
Copy and paste the new template sheet without specifying where to put it
Made sure all calls to sheets included specific "path" (ThisWorkbook.)
Inefficient workaround:
The only thing that prevents this error is code to save, close, and reopen the file. Obviously, this is time consuming and not efficient. I found this code online:
wb.Save
Application.OnTime Now + TimeValue("00:00:01"), Application.Workbooks.Open(filePath)
wb.Close (True)
Finally:
As I stated, I am new to VBA, coding, and this site. Any suggestions to my code, relevant to this issue or not, are greatly appreciated. I have included all the code from my UserForm.
Private Sub OkButton_Click()
'Dont update the screen while the macro runs
Application.ScreenUpdating = False
'Sheet and workbook variables
Dim wb As Workbook
Dim indexSheet As Worksheet, templateSheet As Worksheet
Dim templateCopy As Worksheet, newSheet As Worksheet
'Table and new row variables
Dim Tbl As ListObject
Dim NewRow As ListRow
'Variables to group shapes based on
'need to hide or show them
Dim hideShapes() As Variant, showShapes() As Variant
Dim hideGroup As Object, showGroup As Object
'Misc variables
Dim i As Integer
Dim exists As Boolean
Dim filePath As String
'Variables to assign ranges
Dim scenarioRng As Range
Dim traceabilityFocus As Range
Dim testCaseRng As Range
Dim statusRng As Range
Dim newSheetTestCaseRng As Range
Dim newSheetStatusRng As Range
Dim newSheetFocus As Range
Dim newSheetDateRng As Range
'Create array of shapes based on visibility rules
hideShapes = Array("TextBox 2", "Rectangle 1")
showShapes = Array("TextBox 15", "TextBox 14", "TextBox 13", "TextBox 11", "StatsRec", "Button 10")
'To reference Traceability Matrix sheet
Set indexSheet = ThisWorkbook.Sheets("Traceability Matrix")
'To reference Template sheet
Set templateSheet = ThisWorkbook.Sheets("TestCase_Template")
'To reference traceability matrix table
Set Tbl = indexSheet.ListObjects("TMatrix")
'Set hideShapes to a hide group
Set hideGroup = indexSheet.Shapes.Range(hideShapes)
'Set show shapes to a show group
Set showGroup = indexSheet.Shapes.Range(showShapes)
'To reference this workbook
Set wb = ThisWorkbook
'Get file path of this workbook and set it to string
filePath = wb.FullName
'If the userform fields are empty then show error message
If ScenarioNameBox.Value = "" Or TestCaseNameBox.Text = "" Then
MsgBox ("Please complete both fields.")
'If the userform fields are completed and a worksheet with
'the same name exists, set boolean to true
Else
For i = 1 To Worksheets.Count
If ThisWorkbook.Worksheets(i).Name = TestCaseNameBox.Value Then
exists = True
End If
'Iterate through all worksheets
Next i
'If test case name already exists, show error message
If exists Then
MsgBox ("This test case name is already in use. Please choose another name.")
'If test case name is unique, update workbook
Else
'Copy template sheet to after traceability matrix sheet
templateSheet.Copy After:=indexSheet 'LOCATION OF ERROR!!!
'Ensure template sheet is hidden
templateSheet.Visible = False
'To reference copy of template
Set templateCopy = ThisWorkbook.Sheets("TestCase_Template (2)")
'Rename template sheet to the test case name
templateCopy.Name = TestCaseNameBox.Value
'To reference re-named template sheet
Set newSheet = ThisWorkbook.Sheets(TestCaseNameBox.Value)
'Show new sheet
newSheet.Visible = True
'Set focus to traceability matrix
Set traceabilityFocus = indexSheet.Range("A1")
'Add a new row
Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
'Set ranges for cells in traceability table
Set scenarioRng = indexSheet.Range("B" & NewRow.Range.Row)
Set testCaseRng = scenarioRng.Offset(0, 1)
Set statusRng = testCaseRng.Offset(0, 1)
'Set scenario cell with name and format
With scenarioRng
.FormulaR1C1 = ScenarioNameBox.Value
.HorizontalAlignment = xlGeneral
.Font.Name = "Arial"
.Font.Size = 12
End With
'Set test case cell with name, hyperlink to sheet, and format
With testCaseRng
.FormulaR1C1 = TestCaseNameBox.Value
.Hyperlinks.Add Anchor:=testCaseRng, Address:="", SubAddress:=newSheet.Name & "!A1", TextToDisplay:=newSheet.Name
.HorizontalAlignment = xlGeneral
.Font.Name = "Arial"
.Font.Size = 12
End With
'Set trial status as Incomplete and format
With statusRng
'Set new test case to "Incomplete"
.Value = "Incomplete"
.Font.Name = "Arial"
.Font.Size = 12
.Font.Color = vbBlack
End With
'Show or hide objects
hideGroup.Visible = False
showGroup.Visible = True
'Set ranges for cells in test case table
Set newSheetTestCaseRng = newSheet.Range("C2")
Set newSheetStatusRng = newSheet.Range("C12")
Set newSheetDateRng = newSheet.Range("C5")
'Insert test case name into table
newSheetTestCaseRng.Value = TestCaseNameBox.Value
'Add todays date to Date Created
newSheetDateRng.Value = Date
'Set status to "Incomplete"
newSheetStatusRng.Value = "Incomplete"
'End with cursor at beginning of table
newSheet.Activate
Range("C3").Activate
'wb.Save
'Application.OnTime Now + TimeValue("00:00:01"), Application.Workbooks.Open(filePath)
'wb.Close (True)
'Close the userform
Unload Me
End If
End If
'Update screen
Application.ScreenUpdating = True
End Sub
===========================================================================
Update:
Using the code provided by #DavidZemens the error acts differently. Normally, the userform closes after each sheet is created. #DavidZemens suggested leaving the form open so the user can make as many sheets as they need in one go. This method allows me to create a seemingly unlimited amount of sheets WITHOUT error. Read: at the 22 sheet mark, there is no error.
However, if I manually close the userform after making more than 22 sheets and then reopen it to create a new sheet, the automation error pops up again and excel crashes.
The new code that causes this error is here:
With templateSheet
.Visible = xlSheetVisible
.Copy Before:=indexSheet 'ERRORS HERE!!
.Visible = xlSheetVeryHidden
Another thing worth mentioning: In the project explorer it lists all my sheets with their names. But, there are extra sheets in there that have the workbook icon next to them. I did not create any of there workbooks or worksheets and my macros do not create or even call any workbook other than ThisWorkbook.
I don't have any idea if this will solve the problem, but I tried to clean up the code a bit. See if this helps. I created about 28 sheets without any error.
There is some consolidation/cleanup but I wouldn't expect that to be substantial. However, I did remove the call to Unload Me which isn't strictly necessary (the user can always close out of the form manually, and by omitting that line we also allow the user to create as many sheets as he or she wants without having to launch the form anew each time).
Option Explicit
Private Sub OkButton_Click()
'Dont update the screen while the macro runs
Application.ScreenUpdating = False
'Sheet and workbook variables
Dim wb As Workbook
Dim indexSheet As Worksheet, templateSheet As Worksheet
Dim templateCopy As Worksheet, newSheet As Worksheet
'Table and new row variables
Dim Tbl As ListObject
Dim NewRow As ListRow
'Variables to group shapes based on
'need to hide or show them
Dim hideShapes() As Variant, showShapes() As Variant
Dim hideGroup As Object, showGroup As Object
'Misc variables
Dim i As Integer
Dim exists As Boolean
Dim filePath As String
'Variables to assign ranges
Dim scenarioRng As Range
Dim traceabilityFocus As Range
Dim testCaseRng As Range
Dim statusRng As Range
Dim newSheetTestCaseRng As Range
Dim newSheetStatusRng As Range
Dim newSheetFocus As Range
Dim newSheetDateRng As Range
'Create array of shapes based on visibility rules
hideShapes = Array("TextBox 2", "Rectangle 1")
showShapes = Array("TextBox 15", "TextBox 14", "TextBox 13", "TextBox 11", "StatsRec", "Button 10")
'To reference this workbook
Set wb = ThisWorkbook
'To reference Traceability Matrix sheet
Set indexSheet = wb.Sheets("Traceability Matrix")
'To reference Template sheet
Set templateSheet = wb.Sheets("TestCase_Template")
'To reference traceability matrix table
Set Tbl = indexSheet.ListObjects("TMatrix")
'Set hideShapes to a hide group
Set hideGroup = indexSheet.Shapes.Range(hideShapes)
'Set show shapes to a show group
Set showGroup = indexSheet.Shapes.Range(showShapes)
'Get file path of this workbook and set it to string
filePath = wb.FullName
'If the userform fields are empty then show error message
If ScenarioNameBox.Value = "" Or TestCaseNameBox.Text = "" Then
MsgBox "Please complete both fields."
GoTo EarlyExit
'If the userform fields are completed and a worksheet with
'the same name exists, set boolean to true
Else
On Error Resume Next
Dim tmpWS As Worksheet
' This will error if sheet doesn't exist
Set tmpWS = wb.Worksheets(TestCaseNameBox.Value)
exists = Not (tmpWS Is Nothing)
On Error GoTo 0
End If
'If test case name already exists, show error message
If exists Then
MsgBox "This test case name is already in use. Please choose another name."
GoTo EarlyExit
'If test case name is unique, update workbook
Else
'Copy template sheet to after traceability matrix sheet
With templateSheet
.Visible = xlSheetVisible
.Copy Before:=indexSheet
.Visible = xlSheetVeryHidden
End With
Set newSheet = wb.Sheets(indexSheet.Index - 1)
With newSheet
newSheet.Move After:=indexSheet
'Rename template sheet to the test case name
.Name = TestCaseNameBox.Value
'To reference re-named template sheet
.Visible = True
'Set ranges for cells in test case table
Set newSheetTestCaseRng = .Range("C2")
Set newSheetStatusRng = .Range("C12")
Set newSheetDateRng = .Range("C5")
'Insert test case name into table
newSheetTestCaseRng.Value = TestCaseNameBox.Value
'Add todays date to Date Created
newSheetDateRng.Value = Date
'Set status to "Incomplete"
newSheetStatusRng.Value = "Incomplete"
'End with cursor at beginning of table
.Activate
.Range("C3").Activate
End With
'Set focus to traceability matrix
Set traceabilityFocus = indexSheet.Range("A1")
'Add a new row
Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
'Set ranges for cells in traceability table
Set scenarioRng = indexSheet.Range("B" & NewRow.Range.Row)
Set testCaseRng = scenarioRng.Offset(0, 1)
Set statusRng = testCaseRng.Offset(0, 1)
'Set scenario cell with name and format
With scenarioRng
.FormulaR1C1 = ScenarioNameBox.Value
.HorizontalAlignment = xlGeneral
.Font.Name = "Arial"
.Font.Size = 12
End With
'Set test case cell with name, hyperlink to sheet, and format
With testCaseRng
.FormulaR1C1 = TestCaseNameBox.Value
.Hyperlinks.Add Anchor:=testCaseRng, Address:="", SubAddress:=newSheet.Name & "!A1", TextToDisplay:=newSheet.Name
.HorizontalAlignment = xlGeneral
.Font.Name = "Arial"
.Font.Size = 12
End With
'Set trial status as Incomplete and format
With statusRng
'Set new test case to "Incomplete"
.Value = "Incomplete"
.Font.Name = "Arial"
.Font.Size = 12
.Font.Color = vbBlack
End With
'Show or hide objects
hideGroup.Visible = False
showGroup.Visible = True
wb.Save
End If
EarlyExit:
'Update screen
Application.ScreenUpdating = True
End Sub
hope this helps - I was updating a table with UserForm but at the same time had a named range defined which was reading the column values from the same table using INDIRECT. After removing the named range all works fine.
I'm working on moving a worksheet into an add-in so I can make updates to the code without having to give new workbooks to everyone. The process has been fairly straightforward until I got to the area where add-in code needs to modify ActiveX controls present on the sheet.
The previous code I was using to modify these:
If Sheet1.Range(RowHighlightToggle.LinkedCell).Value = True Then
RowHighlightToggle.Caption = "Row Highlight - On"
HighlightStatus = 0
Else
RowHighlightToggle.Caption = "Row Highlight - Off"
HighlightStatus = 1
End If
RowHightlightToggle being the ActiveX control in question. I'm not sure how to refer to this button when coding inside the add-in. I've tried doing Sheet1.RowHighlightToggle.LinkedCell and that is giving me an error as well. I'm not using Sheet1 inside the add-in as I have a function to get codenames from the target workbook so Sheet1 is usually something like AWSheet1 but it is a Worksheet variable so that is not the issue either. I can read the linked cell value quite easy but I have no way of changing the button caption without somehow referring to the button inside the code.
This button will always be present in the workbook that this add-in is being made for, I have additional code to make sure the add-in is only visible in that workbook as well and hides itself for any others.
Is there a way to refer to the button through the add-in or possibly a way to link the caption to a cell so I can change the cell value to update the caption?
After a bit more research I found out I can refer to it by using OLEObjects, working code including the rest of the sub is below.
Sub RowHighlightToggle()
'-----Startup Code--------
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.DisplayAlerts = False
End With
'------------------------
Dim HighlightStatus As Long, AWSheet1 As Worksheet, ThisButton As Object
If TargetWorkbook Is Nothing Then Set TargetWorkbook = ActiveWorkbook
Set AWSheet1 = GetWsFromCodeName(TargetWorkbook, "Sheet1")
Set ThisButton = AWSheet1.OLEObjects("RowHighlightToggle")
Call Common_Functions.StartUnlock
If AWSheet1.Range(ThisButton.LinkedCell).Value = True Then
ThisButton.Object.Caption = "Row Highlight - On"
HighlightStatus = 0
Else
ThisButton.Object.Caption = "Row Highlight - Off"
HighlightStatus = 1
End If
Call Common_Functions.StartLock
If Worksheets.Count > 6 Then
Call Common_Functions.SheetArrayBuild(TargetWorkbook)
For i = LBound(SheetArray) To UBound(SheetArray)
Sheets(SheetArray(i, 1)).Range("Z1").Value = HighlightStatus
Next i
End If
'-----Finish Code--------
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.DisplayAlerts = True
.EnableEvents = True
End With
'------------------------
End Sub
And the function to get the worksheet from the workbook
Function GetWsFromCodeName(wb As Workbook, CodeName As String) As Excel.Worksheet
Dim ws As Excel.Worksheet
For Each ws In wb.Worksheets
If ws.CodeName = CodeName Then
Set GetWsFromCodeName = ws
Exit For
End If
Next ws
End Function
Assuming the control is on Sheet1, you should be able to use:
Sheet1.RowHightlightToggle.Caption = "Row Highlight - On"
But you can also get at the control using the shapes collection:
Sheet1.Shapes("RowHightlightToggle").DrawingObject.Object.Caption = "Row Highlight - On"
Or, with a more generic workbook variable:
Dim userWorkbook as Workbook
Set userWorkbook = Workbooks("UserData.xlsm")
userWorkbook.Worksheets("Foo").Shapes("RowHightlightToggle").DrawingObject.Object.Caption = "Row Highlight - On"
I am creating an macro-enabled Excel as a tool for generating 'create table' sql script. The sheet is created where one needs to enter the column names, data type etc., and on a button click the script will be generated. This sheet is called 'Script Generator'. Now I need an 'Index' sheet which will have table names and a button. When I click the button I need to open 'script generator' sheets for each table name and these sheets should be renamed to the table name.
The index sheet code goes like this:
Sub Add_sheets()
On Error Resume Next
Dim count As Integer
Dim r As Range
Dim sh As Worksheet
For Each r In Range("A3:A103")
If Not r = "" Then
count = 0
For Each sh In ActiveWorkbook.Sheets
If sh.Name = r.Value Then
count = count + 1
End If
Next sh
If count = 0 Then
With ActiveWorkbook.Sheets
.Add(after:=Worksheets(Worksheets.count), Type:="C:\Macro\Script_Template.xltm").Name = r.Value
End With
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", _
SubAddress:=Sheets(r.Value).Name & "!A1"
End If
End If
Next r
End Sub
Now, the problem is I am adding the script generator saved as 'Script_Template.xltm' externally. I need only one Excel which will do this all. Means, the Index file should internally open/add the new sheets of the format 'script generator' so that it forms one complete tool. Maybe by hiding this sheet and calling its instances through macros and renaming those sheets. How to do it through VBA? Could someone help me with this?
Using True and False for setting the Visible property of a worksheet is not good practice. You should use the constants already provided - xlSheetHidden, xlSheetVeryHidden and xlSheetVisible.
xlSheetVisible will make your sheet visible and xlSheetHidden will hide your sheet. Setting it to xlSheetVeryHidden will ensure that the only way you can make the sheet visible is through VBA and not through the Excel menubar Format -> Sheet -> Unhide.
Usage:
Sheets("Script_Template").Visible = xlSheetVisible
You can create a "Script_Template" sheet and hide it and then use this code create a copy
Sheets("Script_Template").Visible = True
Sheets("Script_Template").Copy After:=Sheets(ThisWorkbook.Sheets.count)
ActiveSheet.Name = r.Value
Sheets("Script_Template").Visible = False