I am working with a workbook where you can choose a list of countries in a dropdown menu.
When changing the name, the Pivot table is updated to the corresponding Worksheet and Table.
The Pivot updating works and it changes the source depending on the country chosen.
The next step is that I want some data from the table that we connected to the worksheet to do some calculations.
If I choose the name of the worksheet and table directly in the "set" step, they are not changing depending on my dropdown selection.
Sub NORDICS()
Dim tblName As String
Dim ws1 As Worksheet
Dim ams As Long
Dim Target As Variant
Dim average As Variant
Dim tbl As ListObject
Set ws1 = Worksheets("Nordics")
Set tbl = ws1.ListObjects("TableNordics")
''What is the Table Name
Range("E3").Formula = "=""Table""&F3"
''Set tblName to the "calculated" table name above
tblName = Range("E3")
''Update the source to "PivotTable1" to be the tblName
Application.CutCopyMode = False
ActiveSheet.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblName, Version:=6)
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(2).Points(53).Select
Selection.Format.Line.EndArrowheadStyle = msoArrowheadStealth
''Collect the Last row of the Table Body
ans = tbl.DataBodyRange.Rows.Count
''Collect the Last cell value of column 8 and last row calculated above
Target = tbl.DataBodyRange(ans, 8).Value
''Collect the Total Rows Value from the Table
With tbl
average = .TotalsRowRange.Cells(.ListColumns.Count).Value
End With
''Calculate the average vs Target value and put in "W3"
Range("W3") = average - Target
''Remove Calculations done on worksheet that is not needed any more
Range("E3").Formula = "="""""
Range("E3").Value = Range("E3").Value
End Sub
My end goal would be that
Set ws1 = Worksheets("Nordics")
Set tbl = ws1.ListObjects("TableNordics")
is
Set ws1 = Worksheets = Range("F3")
Set tbl = ws1.ListObjects = Range("E3")
Related
I want to update data in any table using this format:
Dim Update As String
Dim FindUpdate As Range
Update = Range("USER_NAME").value
With Sheets("Settings")
Set FindUpdate = .Range("USERS_TABLE").Find(What:=Update, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
.Cells(FindUpdate.row, 6).value = Computer
End With
This code works but it requires me to put this table at the beginning of the Sheet.
I want to change values in a table (ListObjects("USERS_TABLE")) regardless of where it's positioned in the worksheet. Changing the range to a table's name USERS_TABLE did not do the trick.
Ideally I want to change the above code to:
Dim Update As String
Update = Range("USER_NAME").value ' This is a Namedrange
' declare a variables that will point to a table I want to access
dim ws as Worksheet
Set ws = ActiveSheet
Dim table_row as ListRow
Set table_row = ws.ListObject("USERS_TABLE").ListRows.**SOMETHING_TO_HELP_ACCESS_THE_TABLE_ROW_HERE**
Dim FindUpdate As Range
With table_row ' REPLACE SHEETS WITH TABLE_ROW
Set FindUpdate = .**Row?**.Find(What:=Update, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
' AND CAUSE IT'S A TABLE, MAYBE A COLUMN HERE?
.**Cells(or Range)?**(FindUpdate.**row**, 6).value = Computer
End With
TO #VBasic2008, sorry for the confusion, but... This is what I have... It works I can add rows using this
Public Sub Add_Table_Row()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim add_row As ListRow
Set add_row = ws.ListObjects("Names_Table").ListRows.Add(1)
With add_row
.Range(3) = "Sample Text"
End With
End Sub
I want to use the above method to update Table values, like this...
Public Sub Update_Table_Row()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim update_row As ListRow
Set update_row = ws.ListObjects("Names_Table").ListRows ' STUCK HERE
With update_row
.Range(3) = "Change This Text"
End With
End Sub
is it work?
Public Sub Update_Table_Row()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim update_row As ListRow
Set update_row = ws.ListObjects("Names_Table").ListRows ' STUCK HERE
With update_row
.Range(3) = "Change This Text"
End With
End Sub
Sorry for the late reply... Found a simple solution to ADD and UPDATE a Table (ListObjects.ListRow) Row
1. Add Table Row with values
Sub Add_Product()
' Declare Products Database Variable
Dim Products_Table As ListObject
Set Products_Table = Sheets("Products").ListObjects("PRODUCT_DATABASE")
' Declare Add Product Variable
Dim Product_New_Row As ListRow
Set Product_New_Row = Products_Table.ListRows.Add(1)
With Product_New_Row
.Range(1) = "PRODUCTSKU01" ' 1st Column
.Range(2) = "New Product Name" ' 2nd Column
.Range(5) = 1000 ' 5th Column
End With
End Sub
2. Change Table Row Values
Sub Update_Product()
' Declare Products Database Variable
Dim Products_Table As ListObject
Set Products_Table = Sheets("Products").ListObjects("PRODUCT_DATABASE")
' Declare Search Value
Dim Find_Value As String
Find_Value = "PRODUCTSKU01" ' 1st Column of the Products Database
' Declare Product Row
Dim Product_Update_Row As Range
Set Product_Update_Row = Products_Table.DataBodyRange.Find( _
What:=Find_Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext _
)
' Update Product
With Product_Update_Row
' Change column # value
.Cells(1, 2).value = "Change Product Name"
End With
End Sub
I'm have various tables stacked on top of each other forming various product offerings to sell. Within each table are offerings related to that group (think grocery and Produce might be the title of the table and then below that lettuce, tomatoes, cabbage, etc as headers with one header being qty - the first column). I want to iterate through each table and for each table that has a qty > 0 print the title of the table and only rows that have a qty>0.
My thought below was to iterate through each table (starting with table1) and if the qty>0, then copy that row into a dynamically created table, add the rows then mark a global flag as true. If true then paste the title, headers, then the created table. I don't know how to add rows to the table though....
Sub CopyRows()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws, ws2 As Worksheet
Set ws = wb.Sheets("Summary")
Set ws2 = wb.Sheets("Sales Ops Ready - Rob")
Dim checkFlag As Boolean
Dim lo As ListObject
Dim globalRowCount As Long
Dim objTable As ListObject
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
Set lo = ws.ListObjects("Table1")
For rw = 1 To lo.Range.Rows.Count
If lo.DataBodyRange(rw, 1) > 0 Then
checkFlag = True
??
End If
Next
End Sub
Here is a rough idea of how it can be done without knowing your exact requirements.
Sub test()
Dim rw As ListRow
Dim newRow As ListRow
Dim lo As ListObject
Dim objTable As ListObject
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
For Each rw In lo.ListRows
If rw.Range(1) > 0 Then 'set the column index here
Set newRow = objTable.ListRows.Add
With newRow
.Range(1) = rw.Range(1)
.Range(2) = rw.Range(2)
'... ... etc
End With
End If
Next rw
End Sub
I am trying to create a macro that will take data that starts at A18, find the last row and last column then generate a pivot table. I searched around to take bits and pieces from code I found online to try to make something work.
I keep getting a 1004 error, and I suspect it is because my code isn't actually selecting the data range properly.
this is the code that the error happens on:
Set pvtable = pvcache.CreatePivotTable(TableDestination:=pvsheet.Cells(1, 1), TableName:="Payroll")
this is all of the code:
Dim pvtable As PivotTable
Dim pvcache As PivotCache
Dim ptrange As Range
Dim pvsheet As Worksheet
Dim pdsheet As Worksheet
Dim plr As Long
Dim plc As Long
Dim startCell As Range
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("Pivot table").Delete 'to delete the existing pivot table in the worksheet
Worksheets.Add After:=ActiveSheet ' to add a new worksheet
ActiveSheet.Name = "Pivot Table" ' to rename the worksheet
On Error GoTo 0
Set pvsheet = Worksheets("Pivot table")
Set pdsheet = Worksheets("sheet1")
Set startCell = Range("A18")
'two variable to find Last used row and column in sheet 1, raw data'
plr = pdsheet.Cells(pdsheet.Rows.Count, startCell.Column).End(xlUp).Row
plc = pdsheet.Cells(startCell.Row, pdsheet.Columns.Count).End(xlToLeft).Column
'set range from selected data
Set ptrange = pdsheet.Cells(1, 1).Resize(plr, plc)
'pivot cahe needed for data load
Set pvcache = ActiveWorkbook.PivotCaches.Create(xlDatabase, SourceData:=ptrange)
'create empty pivot table
Set pvtable = pvcache.CreatePivotTable(TableDestination:=pvsheet.Cells(1, 1), TableName:="Payroll")
'Insert worker to Row Filed
With pvsheet.PivotTables("Payroll").PivotFields("Worker")
.Orientation = xlRowField
.Position = 1
End With
'Insert Street to Row Filed & position 2
With pvsheet.PivotTables("Payroll").PivotFields("Actual Hours")
.Orientation = xlRowField
.Position = 2
End With
'to show the pivot table in Tabular form
pvsheet.PivotTables("Payroll").RowAxisLayout xlTabularRow
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I am suspecting the issue is within this area here where the data range is selected to make the pivot table:
Set pvsheet = Worksheets("Pivot table")
Set pdsheet = Worksheets("sheet1")
Set startCell = Range("A18")
'two variable to find Last used row and column in sheet 1, raw data'
plr = pdsheet.Cells(pdsheet.Rows.Count, startCell.Column).End(xlUp).Row
plc = pdsheet.Cells(startCell.Row, pdsheet.Columns.Count).End(xlToLeft).Column
'set range from selected data
Set ptrange = pdsheet.Cells(1, 1).Resize(plr, plc)
any help appreciated, thank you
Try defining your range as follows...
Set ptrange = pdsheet.Range(startCell, pdsheet.Cells(plr, plc))
Or, alternatively...
Set pdsheet = Worksheets("sheet1")
Set startCell = pdsheet.Range("A18")
With pdsheet
plr = .Cells(.Rows.Count, startCell.Column).End(xlUp).Row
plc = .Cells(startCell.Row, .Columns.Count).End(xlToLeft).Column
Set ptrange = .Range(startCell, .Cells(plr, plc))
End With
I am trying to dynamically retrieve the range address of data then change the pivot table data source range address.
There are three sheets involved.
1) ThisWorkbook.Worksheets("sheet1") - main dashboard, has pivot chart and slicer that were moved from sheet2
2) ThisWorkbook.Worksheets("sheet2") - Pivot Table
3) ThisWorkbook.Worksheets("sheet3") - source data that was copied from different workbook before the below code runs.
My code gives
Run-time error 5: Invalid Procedure call or argument
The error points to Set pt = Pivot_sht.PivotTables(PivotName).ChangePivotCache(pc)
I have two other pivot charts on my main sheet. Using the same code they refresh without any issues.
Full code:
Option Explicit
Sub test()
Dim daMa As Worksheet
Dim daPerf As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim DataRange As Range
Dim PivotName As String
Dim NewRangePH As String
Dim pt As PivotTable
Dim pc As PivotCache
'REFRESHING PERFORMANCE HISTORY
'Set Variables Equal to Data Sheet and Pivot Sheet
Set Data_sht = ThisWorkbook.Worksheets("sheet3")
Set Pivot_sht = ThisWorkbook.Worksheets("sheet2")
'Enter in Pivot Table Name
PivotName = "PHPivot"
With Data_sht
.Activate
'Dynamically Retrieve Range Address of Data
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
LastCol = 12
Set DataRange = Data_sht.Range(Cells(LastRow, 1).Address, Cells(1, LastCol).Address)
End With
NewRangePH = Data_sht.Name & "!" & _
DataRange.Address(ReferenceStyle:=xlR1C1)
'Make sure every column in data set has a heading and is not blank (error prevention)
If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
MsgBox "One of your data columns has a blank heading." & vbNewLine _
& "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
Exit Sub
End If
'Change Pivot Table Data Source Range Address
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRangePH)
Set pt = Pivot_sht.PivotTables(PivotName).ChangePivotCache(pc)
End Sub
I searched through many Google result and results from Stack Overflow and tried at least 10 different things before posting this question.
"set pt = " is worng, you do not want to set a new pivottable.
Instead use
Pivot_sht.PivotTables(PivotName).ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
newRangePH, Version:=xlPivotTableVersion15)
I am stuck writing this Excel macro and could kindly use some help. I am trying to create a dynamic macro that will compare two tables in two different sheets and will update information for a row if different or copy a new row to the new table if not there. Both tables contain the same columns of info and have a unique product code per data row. Once a button is pressed, if the product code for the row in table1 is not found on the new table then that row will copy. If the product code is found in the new table but other information in columns is different, than that other information will be updated on the new table. If the product code is found and the other information is the same then that row will not be copied. I need this for as many lines as possible in table1.
NOTE: I thought VLOOKUP may be the route to successfully code this macro...BELOW is my attempt so far to get this to work.
Sub Copy_Attempt()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Raw Data")
Set s2 = Sheets("BAS Linkage Master")
Dim i As Integer
Dim j As Integer
Dim Proj_ID As String
Dim Lookup_Range As Range
Dim Linkage_Lookup_Range As Range
Dim Raw_Percent_Complete As String
Dim Linkage_Percent_Complete As String
Set Lookup_Range = s1.Range("A1:O1000")
Set Linkage_Lookup_Range = s2.Range("A6:N1000")
For i = 2 To 1000
Proj_ID = s1.Range("F" & i).Value
Raw_Percent_Complete = Application.WorksheetFunction.VLookup(Proj_ID, Lookup_Range, 10, False)
Next
For j = 7 To 1000
Linkage_Percent_Complete = s2.Range("I" & j).Value
Next
If Raw_Percent_Complete = Linkage_Percent_Complete Then
' DO NOT COPY THAT ROW OVER
Else
Percent_Complete = Range("I" & j).Value
'UPDATE PERCENT COMPLETE FOR THAT SPECIFIC PRODUCT CODE
End If
Sheets("Raw Data").Activate
Columns("H").EntireColumn.Delete
Range("A2:P1000").Select
Selection.Copy
Sheets("BAS Linkage Master").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial
' Sheets("Welcome").Activate
' Range("A11:O11").ClearContents
Sheets("Raw Data").Activate
Range("A2:N10000").ClearContents
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets("BAS Linkage Master").Activate
End Sub
This is a nice little script that looks for differences and highlights the differences.
Public Sub CompareSheets()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim cell As Range, rng As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set rng = ws1.Range("A1:B20")
For Each cell In rng
Celladdress = cell.Address
If cell <> ws2.Range(Celladdress) Then
cell.Interior.Color = vbYellow
ws2.Range(Celladdress).Interior.Color = vbYellow
End If
Next cell
End Sub
You can use the same concept to copy the values from one table to another.
Public Sub CompareSheets()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim cell As Range, rng As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set rng = ws1.Range("A1:B20")
For Each cell In rng
Celladdress = cell.Address
If cell <> ws2.Range(Celladdress) Then
ws2.Range(Celladdress).Value = ws1.Range(Celladdress).Value
End If
Next cell
End Sub