Somehow my Pivot Table created from my VBA script displays different data than when i create the pivot table manually.
My macro does the following:
Database is in sheet 2. Pivot is in sheet 1.
Macro deletes all rows in sheet 2 and adds new data.
M deletes rows containing the current pivot.
M deletes the data-connection for the pivot.
M creates new data-connection for the new data in sheet 2 and creates a new
pivot in sheet 1.
Everything works without errors, but somehow the data is not the same as to when i create the pivot manually.
My guess is that it uses some old data-connection, but im not sure how or how to fix this.
VBA - Code for pivot table creation:
'Delete old pivot
Sheets("Sheet1").Select
Range("A1:C5").Select
Selection.ClearContents
'Create new Connection
ActiveWorkbook.Connections("PivotConnection").Delete
Workbooks("File.xlsm").Connections.Add2 _
"PivotConnection", "", _
"WORKSHEET;*ABSOLUTE PATH*[File.xlsm]Sheet2" _
, "Sheet2!$A:$Q", 7, True, False
'Create new pivot
ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
ActiveWorkbook.Connections("PivotConnection"), Version:=6).CreatePivotTable _
TableDestination:=Worksheets("Sheet1").Cells(1, 1), TableName:="PivotTable3", DefaultVersion:=6
With ActiveSheet.PivotTables("PivotTable3")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = True
.CompactRowIndent = 1
.VisualTotals = False
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = True
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.DisplayEmptyRow = False
.DisplayEmptyColumn = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.DisplayImmediateItems = True
.ViewCalculatedMembers = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = True
.RowAxisLayout xlCompactRow
End With
ActiveSheet.PivotTables("PivotTable3").PivotCache.RefreshOnFileOpen = False
ActiveSheet.PivotTables("PivotTable3").RepeatAllLabels xlRepeatLabels
Thanks in advance
EDIT:
Just to clarify how the data is incorrect:
The distinct count of a row gives me e.g. 1000
I run the macro and new pivot with modified data is created
Distinct count still shows 1000
Manually created pivot shows e.g. 980 for distinct count
Related
I have a sheet with 1532 rows and 7 columns called "Delayed Students". I want to make a pivot table in the sheet but every time I use my code, I get a
run-time error'438 "Object doesn't support this property or method"
And this area is yellow (.Position =1):
With .PivotFields("FACULTY_ID")
.Orientation = xlDataField
.Postion = 1
But it creates the pivot table anyways. The problem is when i delete the table and try to use the code again it doesn't create the pivot table again. So something must be wrong with my code:
Sub Pivot1()
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Dim PvtTblName As String
Dim pivotTableWs As Worksheet
PvtTblName = "pivotTableName"
Set pivotTableWs = Sheets("Delayed Students")
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Delayed Students!R1C1:R1532C7")
Set PvtTbl = pivotTableWs.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=pivotTableWs.Range("J1"), TableName:=PvtTblName)
With PvtTbl
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
With .PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
.RepeatAllLabels xlRepeatLabels
With .PivotFields("STUDYBOARD_ID")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("FACULTY_ID")
.Orientation = xlDataField
.Postion = 1
End With
End With
End Sub
Hope someone can help me with what i am doing wrong :)
I have an Excel sheet that I would like to serve as the backup of a Google sheet, which I'll be clearing out periodically to prevent it from slowing down. I'm attempting to write a macro which, after a set period of time, will find the next empty row in the Excel sheet, activate the cell in column "A", and import the data from the Google Sheet. I don't want to "refresh" the data in Excel, because the plan is to delete the data in the Google Sheet every so often while the Excel sheet serves as a continuous record. I would simply like to pull the current Google Sheet data into the first cell of the next empty row, and schedule this to repeat.
Here's what I've been trying:
Sub addData()
newCell = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Address
MsgBox newCell
Sheet1.QueryTables.Add(Connection:= _
"URL;googleSheetURL" _
, Destination:=Range(newCell))
.PostText = "transaction-data_1"
.Name = False
.FieldNames = False
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.HasAutoFormat = False
.RefreshOnFileOpen = 2
.BackgroundQuery = False
.TablesOnlyFromHTML = True
.SaveData = True
.Refresh BackgroundQuery:=False
.UseListObject = False
End With
End Sub
Where googleSheetURL is replaced with the published link of the sheet.
I just keep getting errors, debug mode highlights the Refresh BackgroundQuery line. I disabled background refresh because I didn't want the queries to update once I pulled them. Does anyone have any insight?
This code doesn't compile. You're missing a With in front of Sheet1:
Sub addData()
newCell = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Address
With Sheet1.QueryTables.Add(Connection:= _
"URL;googleSheetURL" _
, Destination:=Range(newCell))
.PostText = "transaction-data_1"
.Name = False
.FieldNames = False
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.HasAutoFormat = False
.RefreshOnFileOpen = 2
.BackgroundQuery = False
.TablesOnlyFromHTML = True
.SaveData = True
.Refresh BackgroundQuery:=False
.UseListObject = False
End With
End Sub
Hey so i found a specific query to import a file into excel from a specific row and delete the following datga each time you open it again. but is it also pssible to stop adding rows at a specific line? and is it possible to leave some rows out if there for example is a specific word in that line?
Sub Sample()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\sample.txt", Destination:=Range("$A$1") _
)
.Name = "Sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
You can do it, but not with a Querytable.
Try this code:
Private Sub Open_Click()
Dim fn As Variant, myLine As Long, txt As String, x As Variant, ouput As String
Dim i As Integer, j As Integer: j = 1
Dim sht As Worksheet
Set sht = Worksheets("Sheet1") 'Modify Sheet Name
fn = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _
"Open File")
If fn = False Then Exit Sub
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
x = Split(txt, vbNewLine)
For i = 0 To UBound(x)
If x(i) <> "SomeCriteria" Then 'Check for some criteria
sht.Cells(j, 1).Value = x(i)
j = j + 1
End If
Next i
End Sub
So what it does basically, it opens a user selected txt file and stores it in the variable txt. Do seperate the rows you can use the split-function. Now each line is stored in an array x. You could go trough the array/each line and take out the ones you want. To check if a specific word is in a line, use the InStr-function.
While my code works for 10 loop iterations, it crashes for home = 30 or more. Can someone please provide me with a clue? Even weirder this code used to work fine... and is not working anymore.
Here's the code:
Sub datascrap_clean()
'
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim home As Integer
Dim output_rows As Integer
Dim output_columns As Integer
Dim date_columns As Integer
'Output rows and columns starting values
output_rows = 3
output_columns = 3
date_columns = 8
For home = 3 To 33
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.cqc.org.uk/directory/" & Sheets("Output").Cells(home, 1), Destination:=Range("$A$1") _
)
'.CommandType = 0
.Name = "Homes"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
For x = 20 To 250
Select Case Left(Cells(x, 1), 7)
'Is it a score?
Case Is = "Overall"
Sheets("Output").Cells(output_rows, output_columns).Value = Cells(x, 1)
output_columns = output_columns + 1
'Is it a date?
'Case Is = "Carried"
' Sheets("Output").Cells(output_rows, output_columns).Value = Cells(x, 1)
'date_columns = date_columns + 1
Case Else
End Select
Sheets(2).Select
Next x
'Clean sheet
ActiveSheet.Cells.Delete
'Reset column count
output_columns = 3
date_columns = 8
output_rows = output_rows + 1
Next home
MsgBox ("Done!")
End Sub
I had the same problem with creating QueryTable objects within a loop and having Excel hang at seemingly random times (usually after creating about 15 QueryTable objects). I noticed that the problem did not happen when I was in the VBE debugging and running with breakpoints inserted. So, in addition to deleting QueryTable objects after using them as suggested in a previous answer, I inserted a short delay at the start of my loop:
Application.Wait(Now + TimeValue("0:00:02"))
Was able to successfully run a case with ~300 QueryTable objects created with no hanging. Yes, a kludge, but it least provides a work around. Without the delay, I still got Excel to hang even after deleting the QueryTable objects.
I have been working on a workbook for some reporting functions.
I have just been getting back into VB and a bit rusty - in front of me also sits a 1000+ page book and have been all over sites like this. It seems that i can get close - however end up just a bit off.
Every week I have new data coming in, that I will be using to update some pivot tables and so on. I have 5 areas where data will be imported and currently have the import functioning, however I run into issues with two areas: I can't seem to have it create a table of the data that was just imported & I have no error checking. I need the tables named so i can use the date throughout the worksheet.
Any guidance would be great for the following:
How can I simply clear out the current table at A2 and import the new data not to have to rename the table and the headers? (my imported data comes in as "First Name" not First_Name" so would be nice to just keep it in this format.
How do I add error checking on this to say if someone runs it and closes the window that it will not clear the worksheet and launch a debugger?
Here is what i have working (I have tried many things but back to this)
Sub ImportMaster()
' this is the master list of all NA accounts for .....
' NA_ACCOUNTS_LIST Worksheet
Dim ws As Worksheet, strFile As String Set ws = ActiveWorkbook.Sheets("NA_Accounts_List") ws.UsedRange.Clear strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...") With ws.QueryTables.Add(Connection:="TEXT;" & strFile, _ Destination:=ws.Range("A2"))
.Name = "ProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False End With ' ws.Name = "testing"
' updates the date Range("C12").ClearContents Range("C12") = Format(Date, "mm-dd-yyyy")
' This will focus this worksheet after upate Sheets("NA_Accounts_List").Visible = xlSheetVisible Sheets("NA_Accounts_List").Select
MsgBox "Imported data successfully!"
end sub
let me see if i understood, what you want is clear cell A2 from the current table that you are working? and insert a new data at the same cell?
You have lucky, i guess its should solve.
Microsoft.Office.Interop.Excel.Application ex = new Microsoft.Office.Interop.Excel.Application();
ex.Visible = true;
Microsoft.Office.Interop.Excel.Workbook wk = ex.Workbooks.Add(Type.Missing);
Microsoft.Office.Interop.Excel.Worksheet ws = (Microsoft.Office.Interop.Excel.Worksheet)wk.Worksheets[1]; // set the first worksheet
DataTable dtb = mysql.mysql_data_adapter(); // the data that are coming from mysql
DataRow row;
for (int i = 0; i < dtb.Columns.Count; i++) // add header
{
Microsoft.Office.Interop.Excel.Range rg = (ws.Cells[1, i + 1] as Microsoft.Office.Interop.Excel.Range); // excel start in 1
rg.Value2 = dtb.Columns[i].ColumnName.ToString();
}
for (int i = 2; i < dtb.Rows.Count + 2; i++) // add data without change header, and this for run the row
{
row = dtb.Rows[i - 2]; // where to start at correct row, dont oforget, start in 2 because 1 are the header
for (int i2 = 1; i2 < dtb.Columns.Count + 1; i2++) // where run the collumns
{
try
{
Microsoft.Office.Interop.Excel.Range rg = (ws.Cells[i, i2] as Microsoft.Office.Interop.Excel.Range);
rg.Value2 = row[i2 - 1].ToString();
}
catch
{
}
}
}