I'm creating a spreadsheet to view a single product extracting values from a closed workbook (products.xlsx), using the SKU as a lookup value.
This code runs into:
Run-time error '1004': Method 'Range' of object '_Global' failed
I'm developing the spreadsheet to manage WooCommerce Products using Excel for our company's online store. Our need is to view a single product and be able to edit or delete it and also add more products even though the database is not within the current workbook.
Sub get_data_form_another_workbook()
Dim databook As Workbook
Dim test As String
Application.ScreenUpdating = False
' Open database in the background
Set databook = Workbooks.Open(ThisWorkbook.Path & "\products.xlsx")
' loop through database table to get required value
' AND THIS IS WHERE I'M GETTING AN ERROR
test = Application.WorksheetFuncion.VLookup(Range("product_current"), _
databook.Sheets("Sheet1").Range("A:F"), 4, 0)
' Test
Debug.Print test
databook.Close
Application.ScreenUpdating = True
End Sub
Thanks for all the responses... I edited the code a bit and it seems my mistake was on referencing the sheets properly... In the products.xlsb, the sheet I was trying to reference is "data"... Changed "Sheet1" to "data" and it worked...
Sub get_data_form_another_workbook()
Dim databook As Workbook
Dim test As Variant
Application.ScreenUpdating = False
' Open database in the background
Set databook = Workbooks.Open(ThisWorkbook.Path & "\products.xlsx")
' loop through database table to get required value
test = Application.VLookup(ThisWorkbook.Worksheets("product").Range("product_current"), _
databook.Sheets("Data").Range("A:F"), 4, 0)
' Test
Debug.Print test
databook.Close
Application.ScreenUpdating = True
End Sub
Related
I'm having trouble debugging my vba code. The goal of the macro is to take a sheet in the current workbook and save that as a specific csv file. This code worked fine until I got a new computer with Catalina (10.15.4). The error occurs at pasteRange.Value = copyRange.Value and the error code is VBA: Method 'Value' of object 'Range' failed (Run-time error '1004'). So when it errors, MasterLoad.csv is open, but the source data just can't copy over.
Sub SheetToCSV()
Application.ScreenUpdating = False: Application.EnableEvents = False: Application.DisplayAlerts = False
' On Error GoTo Cleanup
Dim strSourceSheet As String
Dim strFullname As String
Dim fileAccessGranted As Boolean
Dim filePermissionCandidates
Dim copyWB As Workbook
Dim pasteWB As Workbook
Dim copyRange As Range
Dim pasteRange As Range
Set copyWB = ThisWorkbook
' set variables for sheet name and file path
strSourceSheet = "MasterLoad"
strFullname = "/Users/mypath/MasterLoad.csv"
' grant permission for VBA to open/save MasterLoad file
filePermissionCandidates = Array(strFullname)
grantFileAccess (filePermissionCandidates)
' set copy range
Set copyRange = copyWB.Sheets(strSourceSheet).Range("A1:ZZ2000")
' open paste WB, set paste range, set values, and save
Set pasteWB = Workbooks.Open(strFullname)
Set pasteRange = pasteWB.Sheets(1).Range("A1:ZZ2000")
pasteRange.Value = copyRange.Value
pasteWB.SaveAs FileName:=strFullname, _
FileFormat:=xlCSV
pasteWB.Close SaveChanges:=True 'close wb and save
Application.ScreenUpdating = True: Application.EnableEvents = True: Application.DisplayAlerts = True
End Sub
Function grantFileAccess(filePermissionCandidates)
grantFileAccess = GrantAccessToMultipleFiles(filePermissionCandidates) 'returns true if access granted, false otherwise_
End Function
I'm not sure if it's actually an OS issue, because I have virtually the same code in a different workbook and it worked fine with the new computer, but nothing has else changed but getting a new computer with this macro. Any thoughts?
Just to be sure, put a breakpoint on the line
pasteRange.Value = copyRange.Value
and check that both the ranges are well defined.
I had a similar issue when copying and inserting an entire column, sometimes it failed with VBA: Method 'Insert' of object 'Range' failed (Run-time error '1004') for no apparent reason and Excel broke completely and had to be restarted. I'm pretty sure it is a bug in Excel.
As suggested by #ComputerVersteher I removed Application.DisplaysAlerts = False and got an error message saying I didn't have enough memory to complete the operation. I changed the copy/paste range to A1:JZ2000 and it worked, but I still don't understand why the range A1:ZZ2000 wouldn't work on my newer/better computer.
I've encountered a strange thing: I've joined three workbooks: Personal Data Tracker, Global Tracker and the workbook with pivots and charts. The logic is as it follows: the user clicks on a button after the work is finished so the data is copied to the GL Tracker. Once the change event is triggered in the GL Tracker Table, the last workbook opens, the pivot is refreshed upon the open vent and the wb is closed.
Everything seems to be working fine, however when I run the macro live, at the very end I get an error message about
"Application-defined or object-defined error".
Only OK and Help button displayed, it doesn't make the VBE Open so I could debug it.
Would anyone know what it may be happening even if the whole chain works fine?
Thank you.
Code from the Personal Tracker:
Sub test()
Dim path As String
Dim wb As Workbook
path = ThisWorkbook.path & "\Dest.xlsm"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Total").Range("R1").Value = Date
Range("R1").Font.Color = VBA.ColorConstants.vbWhite
Worksheets("TOTAL").Range("B2:B13").Copy
On Error GoTo Handler
Workbooks.Open (path)
On Error GoTo 0
Set wb = Workbooks("Dest")
Worksheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValues
Exit Sub
Handler:
MsgBox "Someone else is saving their data at the moment." & vbNewLine & _
"Please try in a few seconds"
End Sub
Code from the GL Tracker:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MRange As Range
Dim wbPivot As Workbook
Dim pt As PivotTable
Dim ws As Worksheet
Dim Name As String
Dim answer As VbMsgBoxResult
Set MRange = ThisWorkbook.Sheets(1).Range("Table1")
Name = Application.UserName
Application.ScreenUpdating = False
If Not Intersect(Target, MRange) Is Nothing Then
Application.EnableEvents = True
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Pivot.xlsm")
End If
'refresh
For Each ws In wbPivot.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.Refresh
pt.Update
pt.RefreshTable
Next
Next
'saving
Application.ScreenUpdating = True
If Application.UserName <> "Jakub Tracz" Then
MsgBox "User not authorised. Workbook will be closed."
wbPivot.Close True
ThisWorkbook.Close True
Else
answer = MsgBox(Prompt:="Do you want to save and close the workbook?", _
Buttons:=vbYesNo + vbQuestion)
Select Case answer
Case vbYes
wbPivot.Close True
ThisWorkbook.Close True
Case vbNo
MsgBox "Welcome, " & Application.UserName
End Select
End If
End Sub
I'm going to give you a proof of concept code as an example for you to use. This will not exactly answer your question with code you can just copy/paste, but you will be able to use this to put it together the way you want it to work instead of me making assumptions about many things and restructuring it myself.
This simply demonstrates how to use a workbook object variable in one routine that can reference another workbook, and how to make changes to that 2nd workbook and save/close it.
Sub Tracker_Update()
Dim wbPivot as Workbook
' open the workbook
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Test.xlsx")
' optionally make it hidden
wbPivot.Visible = False
With wbPivot
' pretend this code updates the pivot table
.Worksheets(1).Range("A1") = "hello world"
' Close and save it
.Close True
End With
' optionally clear the variable
' this is not really needed in VBA, but if you eventually
' start using VB.NET with Excel as a COM object,
' you will want to know how to do this part when you are done
Set wbPivot = Nothing
End Sub
I think you will like this approach in the end much better in the end anyway, as the code isn't scattered around so much in different places. Easier to debug later, and easier for someone else to understand what you are doing if and when you leave the company.
I have a pivot table in excel which looks like this:
Team Doc 1 Doc 2 Grand Total
Team A 13 12 25
Team B 8 7 15
Team C 32 5 37
Grand Total 53 24 77
I have already written a piece of VBA which will format any drill down sheets for printing (Workbook_NewSheet(ByVal Sh As Object)). However, as I'm trying to make this as user friendly as possible, I'd really like to be able to use vba to automatically rename any worksheets generated from the pivot table. However, I'm not sure how to do it as the content of each worksheet will be different depending on where the user clicks (i.e. if the user clicks in Team A Doc 1 Total then the sheet should be named 'Team A Doc 1' but if the user clicks in Grand Total row of Doc 2 then the sheet should be named 'Grand Total Doc 2') - I think there are something like 15 different worksheet names that could occur which is why I'm guessing the worksheet defaults to Sheet1! I'm thinking that a name could be generated by using offset to pick up the team name or the column name based on the active cell but I'm not really sure where to start so any suggestions/assistance would be greatly appreciated!
Thanks
I wish I could comment, but I can't yet, as I have not enough rep points! (Had to restart my account!)
I can suggest that you record a macro while you do a drill down on any given data point manually, and see how the recorded vba code looks. I would think from there you can configure your code to base the name of your worksheet on some element of the recorded code.
Since, I wanted this to be a comment, I will delete this if it's not helpful.
Update To Your Newly Posted Answer:
To check if the sheet already exists when a user drills down, you can check if the sheet existss after you get the sheet name to and if it does, select it, rather than creating a new one. Otherwise, you create it.
See this code for that:
Private Sub Workbook_NewSheet(ByVal sh As Object)
Application.ScreenUpdating = False
Dim shtCur As Worksheet
Set shtCur = ActiveSheet
Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value
If SheetExists(SheetName) Then
Worksheets(SheetName).Select
Else
shtCur.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
shtCur.Name = "SheetName"
End If
Application.ScreenUpdating = True
End Sub
Function SheetExists(wsName As String, Optional wb As Workbook = Nothing) As Boolean
SheetExists = False
Dim WS As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set WS = wb.Worksheets(wsName)
On Error GoTo 0
If Not WS Is Nothing Then SheetExists = True
End Function
I've managed to come up with something fairly workable:
Private Sub Workbook_NewSheet(ByVal sh As Object)
Dim RN, CN As Byte
Dim SheetName As String
Application.ScreenUpdating = False
ActiveSheet.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
'Names the sheet according to the pivot drill
Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value
'Identifies if worksheet already exists and replaces it if so.
Application.DisplayAlerts = False
On Error Resume Next
mySheetNameTest = Worksheets(SheetName).Name
If Err.Number = 0 Then
Worksheets(SheetName).Delete
MsgBox "The sheet named ''" & SheetName & "'' already exists but will be replaced."
Else
Err.Clear
End If
Application.DisplayAlerts = True
Sheets(ActiveWorkbook.Sheets.Count).Select
ActiveSheet.Name = SheetName
End Sub
Basically it's added onto the newsheet event - the macro adds the new sheet to the end of the workbook, goes to the pivot table sheet and identifies the column and row names of the active cell (since the column name and row name will always be static I can hard code this in) and then locates the newly added sheet (always at the end of the workbook) and renames it. Unfortunately there's an issue if a user tries to drill on the same data twice (can't have two worksheets with the same name) which I'm hoping to iron out.
Thanks for views/comments.
Edit: Updated code to work around worksheet duplication issue, seems to be doing the trick!
Here is what I am trying to do. I am trying to create a workbook based on a template named by the title and to create a workbook for each row. And for the macro to loop until all rows have been depleted.
The deliverables that I want at the end are 3 excel documents named (Alpha.xlsx, Beta.xlsx, Gamma.xlsx) with the corresponding values from access plugged into their corresponding cells in their corresponding workbook. The subsequent math is there because I need to be able to manipulate the values once they are in excel.
Here is some of the research that I've found that I haven't quite been able to make much sense of due to my lack of experience coding in vba.
Links
(I can't post more than 2 so I'll keep the number of articles terse):
Research: databasejournal.com/features/msaccess/article.php/3563671/Export-Data-To-Excel.htm
Example Database/Spreadsheet:
http://www.sendspace.com/file/iy62c0
Image Album (has a picture of the database and the template in case you don't want to download):
http://imgur.com/pytPK,PY8FP#0
Any help will be much appreciated! I've been reading up and trying to figure out how to get this to work #.#
This isn't complete, but should help you get started...
Option Compare Database
Option Explicit
'Enter Location of your Template Here
Const ExcelTemplate = "C:\MyTemplate.xltx"
'Enter the Folder Directory to save results to
Const SaveResutsFldr = "C:\Results\"
Sub CreateWorkbook()
Dim SaveAsStr As String
Dim ExcelApp, WB As Object
'Create Reference to Run Excel
Set ExcelApp = CreateObject("Excel.Application")
'Create Reference to your Table
Dim T As Recordset
Set T = CurrentDb.OpenRecordset("tblData")
'Loop through all Record on Table
While Not T.BOF And T.EOF
'Open Your Excel Template
Set WB = ExcelApp.Workbooks.Open(ExcelTemplate)
'Enter your data from your table here to the required cells
WB.Worksheets("NameOfYourWorkSheet").Range("A1") = T("numValue1")
'Repeat this line for each piece of data you need entered
'Changing the Sheet name, cell range, a field name as per your requirements
'WB.Wor...
'WB.Wor...
'Save and Close the Workbook
SaveAsStr = SaveResutsFldr & T("Title") & ".xlsx"
WB.SaveAs SaveAsStr
WB.Close
Set WB = Nothing
'Move to the Next Record
T.MoveNext
Wend
'Close down the Excel Application
ExcelApp.Quit
Set ExcelApp = Nothing
End Sub
I'm making a ExcelComparer but I bump into a probably obvious error, I clearly missed something.
I run a vba macro in Excel 2007
The exact error I get is "Run-time Error 13: Type Mismatch"
This happens when the loop tries to fetch the second worksheet.name .
So, the first sheetname is returned fine
Below you find the macro
Thanks in advance,
L
Sub compare()
Dim strWorkbook1, strWorkbook2 As String
Dim Workbook1, Workbook2 As Workbook
strWorkbook1 = Worksheets("Sheet1").Range("C5") & Worksheets("Sheet1").Range("D5")
strWorkbook2 = Worksheets("Sheet1").Range("C6") & Worksheets("Sheet1").Range("D6")
Set xlapp = CreateObject("Excel.application")
Set Workbook1 = xlapp.Workbooks.Open(strWorkbook1)
xlapp.Visible = False
Dim ws As Worksheet
For Each ws In Workbook1.Sheets
'ws.Select
If Not ws.Visible = xlSheetVeryHidden Then
MsgBox (ws.Name)
End If
Next ws
xlapp.Close
End Sub
Use this for your For loop:
For Each ws In Workbook1.Worksheets
From MSDN the difference between the Sheets and Worksheets properties are:
This property does not return macro sheets, charts, or dialog sheets.
Use the Sheets property to return those sheets as well as worksheets.
You can also use the specialized properties Excel4MacroSheets and
Excel4IntlMacroSheets to return macro sheets and the Charts property
to return charts.
[Edited my original response as I had tested with different variables rendering my comment incorrect]
In addition the back end of your code will fail as you can't set the Excel Application to close with this line xlapp.Close
You should
close the automated workbook (Workbook1.Close False)
quit the automated application (xlapp.Quit)
Ensure the automated application is destroyed (Set xlapp = Nothing)a
The working part of your code should look like this
Dim ws As Worksheet
For Each ws In Workbook1.WorkSheets
If Not ws.Visible = xlSheetVeryHidden Then MsgBox (ws.Name)
Next ws
Workbook1.Close False
xlapp.Quit
Set xlapp = Nothing
End Sub