I have a workbook (A) that pulls up another (B), copies values from wb B and pastes values to wb A (no table, no formulas; just data).
ActiveWorkbook.Sheets("Sheet1").Range("A1:F" & lonTempWBLastRow).Copy shtNewMonth.Range("A1")
I then attempt to create a table with:
Set NewMonthTable = wbPDRC.ListObjects.Add(xlSrcRange, Range("A1:F" & lonTempWBLastRow), , xlYes)
but get error 1004: a table cannot overlap a range that contains a PivotTable, query results, protected cells, or another table. I delete the named range from the sheet so it's not a named range issue. There's no Pivot, query results, protected cells, or table. I even tried to run a loop on unlisting all tables from the sheet but the loop immediately exits as it doesn't see a table on the sheet. I also attempted to run the table code first on wb B then transfer it as a table VS values but I get the same error on that sheet when attempting this way. If I try to make the table in Excel without VBA, the Format As Table dialog box stays put after hitting "OK" a number of times. There is a connection in wb B which I delete via code prior to transferring the data and have verified once it pastes to wb A that the connection is not there. Ideas?
I am guessing, that the problem is that the table already exists, thus, it is not ok to make a new one. Try this piece of code, changing "Table1" to the name of your table:
Option Explicit
Public Sub TestMe()
Dim newTable As Object
Dim someRange As Range
With ThisWorkbook.Worksheets(1)
Set someRange = .Range("A1:F" & 10)
If Not TableExists("Table1", .Cells.Parent) Then
Set newTable = .ListObjects.Add(xlSrcRange, someRange, , xlYes)
End If
End With
End Sub
Public Function TableExists(tableName As String, ws As Worksheet) As Boolean
On Error GoTo TableExists_Error
If ws.ListObjects(tableName).Name = vbNullString Then
End If
TableExists = True
On Error GoTo 0
Exit Function
TableExists_Error:
TableExists = False
End Function
Or simply open a new Excel file and run it. The A1:F10 range would be formatted.
VBA Excel check if a particular table exist using table name
To make this work I had to create a fake, blank table as soon as the sheet was created then paste the data over to it.
Related
I wrote the following sub for a workbook containing 12 pivot tables (PT) in 6 sheets, all pointing to the same external source (another workbook). It works fine, except that if I wish to manually Refresh one pivot, Excel tells me I need to open the source file. If I then open the pivot's source file, the refresh works OK.
I would prefer to have the pivot cache refreshed in the background, like it once was. What am I missing ?
Sub ChangePivotSourceData(src As String)
Dim pt As PivotTable, wks As Worksheet, pc As PivotCache
'update #1 pt in PIVOT AF
Sheet2.PivotTables(1).ChangePivotCache ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=src)
'adjust all others
For Each wks In ThisWorkbook.Worksheets
Debug.Print Now, wks.Name
For Each pt In wks.PivotTables
Debug.Print Now, pt.Name
pt.CacheIndex = Sheet2.PivotTables(1).CacheIndex
pt.RefreshTable
Next pt
Next wks
Debug.Print Now, "ChangePivotSourceData complete"
End Sub
The sub is called like this:
Workbooks.Open fn, False, True
shMenu.Range("c5").Value = fn
Application.Calculation = xlCalculationManual
'change source of ALL pivots
ChangePivotSourceData fn & "!feesIn" 'feesIn is a named range
Took me a few hours but I found a solution.
The problem is that - at first sight - you can't create a connection to an Excel range. You must have a whole sheet, or a table. In my case, the source data starts at B28 and could not be converted into a table. So I manually created the connection pointing to the whole sheet, bringing back of few rows of garbage. I then went the data/properties/definition, and
- I changed the Command type from Default to SQL
- I changed the Command text to a SQL statement like this: select * from [mySheet$b28:bt4000] where ccy is not null (note the required $ at end of sheet name)
Then I managed to get all pivots to point to that connection and finally I wrote a function to allow changing the connection source workbook name:
With ThisWorkbook.PivotCaches(1)
adoConn = Split(.Connection, ";")
adoConn(3) = "Data Source=" & fn
.Connection = Join(adoConn, ";")
.Refresh
'Debug.Print Now, .CommandText 'sql statement
End With
This way the refreshes are fast, and indeed I only need to refresh the connection to have all 12 PT updated.
I want to create a simple import from one spreadsheet to another and also update data vice versa. Column to column mapping is required when copying and updating values from sheet2 to sheet1. can a VB script / Macro do this. I tried the following for copying but keep getting this error Subscript out of range.
Private Sub Import_Click()
'Assign variable name to Target workbook
Var1 = "C:\ST Test\AAA.xlsm"
Var1S = "Status Report"
Var1R = "$A$3:$A$65536"
'Assign variable name to Target range
'Assign variable name to Source workbook
Var2 = "C:\ST Test\BBB.xlsx"
Var2S = "WORKPLAN"
Var2R = "$A$8:$A$65536"
'Open Source WorkBook
Application.Workbooks.Open ("C:\ST Test\BBB.xlsx")
'Copy from Source to Target
Workbooks(Var2).Sheets(Var2S).Range(Var2R).EntireColumn.Copy _
Destination:=Workbooks(Var1).Sheets(Var1S).Range(Var1R)
'Close Source WorkBook wo/Save
Workbooks(Var2).Close False
End Sub
When usuing the EntireColumn this will select a column based on where your selection is. So if you were going for a range that was not the entire column simply us Range(x).Select/Copy Destination:= Workbooks(y).Range(q)
Another way to look at an operation like this is to simply set the ranges equal to each other with will save time by not using the clipboard.
See this code:
Workbooks("test1.xlsx").Worksheets("Sheet1").Activate
Workbooks("test1.xlsx").Worksheets("Sheet1").Range("A1:A5").Value = Workbooks("test.xlsx").Worksheets("Sheet1").Range("A1:A5").Value
I need to safely transfer the cache of a Pivot Table on an Excel File, into a pivot on a different file. How can I do this?
This is the code I'm using now
(Notice this method works even if the Source pivot Data Source has been eliminated):
Public Sub TransferPivotCache(Source As PivotTable, Target As PivotTable)
Dim TempSheet As Worksheet
Set TempSheet = ThisWorkbook.Sheets.Add
Source.TableRange2.Copy Destination:=TempSheet.Range("A1")
Target.CacheIndex = TempSheet.PivotTables(1).CacheIndex
TempSheet.Delete
End Sub
However when the pivot I'm importing is too big I get the error "Not enough memory" when modifying the cache index property. And afterwards, even the file closes and if I try to reopen it, it's corrupted. Is there a better way to transfer a Pivot Cache between pivot tables?
If your goal it to update another pivot table targeting the same data, then another way would be to create a new PivotCache pointing to the same source. This way, the targeted workbook will build the same PivotCache without the need to copy the DataTable, which is probably the cause of your memory issue.
Public Sub TransferPivotCache(source As PivotTable, target As PivotTable)
Dim pivCache As PivotCache, sh As Worksheet, rgData As Range, refData
' convert the `SourceData` from `xlR1C1` to `xlA1` '
source.Parent.Activate
refData = Application.ConvertFormula(source.SourceData, xlR1C1, xlA1, xlAbsolute)
If IsError(refData) Then refData = source.SourceData
If Not IsError(source.Parent.Evaluate(refData)) Then
' create a new pivot cache from the data source if it exists '
Set rgData = source.Parent.Evaluate(refData)
If Not rgData.ListObject Is Nothing Then Set rgData = rgData.ListObject.Range
Set pivCache = target.Parent.Parent.PivotCaches.Create( _
XlPivotTableSourceType.xlDatabase, _
rgData.Address(external:=True))
pivCache.EnableRefresh = False
target.ChangePivotCache pivCache
Else
' copy the pivot cache since the data source no longer exists '
Set sh = source.Parent.Parent.Sheets.Add
source.PivotCache.CreatePivotTable sh.Cells(1, 1)
sh.Move after:=target.Parent ' moves the temp sheet to targeted workbook '
' replace the pivot cache '
target.PivotCache.EnableRefresh = True
target.CacheIndex = target.Parent.Next.PivotTables(1).CacheIndex
target.PivotCache.EnableRefresh = False
'remove the temp sheet '
target.Parent.Next.Delete
End If
End Sub
I was not able to reproduce the resource issue with my Excel Professional 2010... But have you tried this simpler possibility?:
Public Sub TransferPivotCache(SourcePivot As PivotTable, TargetPivot As PivotTable)
TargetPivot.CacheIndex = SourcePivot.CacheIndex
End Sub
It looks like it does the same (at least within the same workbook), and it avoids creating a whole new sheet.
new to stackoverflow and need a little advice on modifying this code to include the deletion of records further than the exported range when exporting from Access to a specific excel worksheet:
Query to extract all Access data from = Stocklist
Spreadsheet to paste data to (inc headings) = G:\Project\test1.xlsx
Worksheet to extract to is also named "Stocklist" and the range is A1 onwards - there are four columns of data that need overwritten by the updated list which is derived from the query.
The following selects the correct file and overwrites the range A1 onwards:
Public Sub Export()
Dim rstName As Recordset
Set rstName = CurrentDb.OpenRecordset("Stocklist")
Dim objApp As Object, objMyWorkbook As Object, objMySheet As Object, objMyRange As Object
Set objApp = CreateObject("Excel.Application")
Set objMyWorkbook = objApp.Workbooks.Open("G:\Project\test1.xlsx")
Set objMySheet = objMyWorkbook.Worksheets("Stocklist")
Set objMyRange = objMySheet.Cells(objApp.ActiveSheet.UsedRange.Rows.Count + 1, 1)
With objMyRange
rstName.MoveFirst
.Clear
.CopyFromRecordset rstName
End With
This is great if the data is the same size or larger, but if its smaller it leaves the items outside the pasted/exported range in the list (eg range of 400 records will leave all records after 400 present after overwrite. Is there any way to clear the sheet before the data is added?
Also how transferable is excel macro VBA code as I have some validation rules and error handling in other spreadsheets that I would like to add (eg. check file is not open, return msgbox etc)
Any help much appreciated
Will this work for you?
objMySheet.UsedRange.Clear
With objMyRange
rstName.MoveFirst
.Clear
.CopyFromRecordset rstName
End With
I have 2 different workbooks with a set of parameters, e.g. car parts number, sales prices, etc. The 2 different workbooks will always have the same car parts numbers but they are not in order. So I was thinking of using a vlookup to match the parameters on one workbook to the other related to the respective parts' numbers.
Thus, I used vlookup to perform this task. It works, but I want to implement this using a macro, so I would not need to manually do the vlookup every time. Is it possible to create such a macro given that the workbooks (file names) would be different every time?
I actually tried recording the macro and the vlookup records the parameters it needs relating to the file name.
EDIT: code from comment:
Sub Macro1()
ActiveCell.FormulaR1C1 = "=VLOOKUP('[TI_DBP_effective_06 May 2013.xls]NON SLL'!C1,'[TI_DBP_effective_06 May 2013.xls]NON SLL'!C1:C3,3,FALSE)"
Range("I1").Select Selection.AutoFill Destination:=Range("I1:I9779")
Range("I1:I9779").Select
End Sub
Try something like this. You will have to place this macro in your Personal macro workbook, so that it is available all the time, no matter what workbooks are open. It will prompt you for two files, and then open them, and should insert the formula. Let me know if it gives you any trouble since I am not able to test it right now.
NOTE: This looks up the value one column to the LEFT of the cell you select, and then looks in columns 1:3 of the other file. Modify as needed.
Sub Macro1()
Dim file1 As String
Dim file2 As String
Dim wbSource As Workbook
Dim wbLookup As Workbook
Dim startRange As Range
file1 = Application.GetOpenFilename(Title:="Select the file to update")
If Len(Dir(file1)) = 0 Then Exit Sub
file2 = Application.GetOpenFilename(Title:="Select the LOOKUP file")
If Len(Dir(file2)) = 0 Then Exit Sub
Set wbLookup = Workbooks.Open(file2)
Set wbSource = Workbooks.Open(file1)
On Error Resume Next
Set startRange = Application.InputBox("Select the first cell for the formula", "Autofill VLOOKUP", Type:=8)
On Error GoTo 0
If Not startRange Is Nothing Then
Application.Goto startRange
startRange.FormulaR1C1 = "=VLOOKUP('[" & wbSource.Name & "]NON SLL'!RC[-1],'[" & wbLookup.Name & "]NON SLL'!C1:C3,3,FALSE)"
startRange.AutoFill Destination:=startRange.End(xlDown)
End If
End Sub