I am struggling to find out how to add data to a table. I have the following code:
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table1")
tbl.ListRows.Add 1
This adds a new row at the top of the table but how do you then add data to the specific columns in that new table row?
Column 1 in the table = Date
Column 2 in the table = Licence 1
Column 3 in the table = Licence 2
Column 4 in the table = Licence 3
I know if I wanted to add a new row to the bottom of the table then I would use this:
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table1")
Set NewRow = tbl.ListRows.Add
With NewRow
.Range(1) = date
.Range(2) = 378
.Range(3) = 678
.Range(4) = 897
End With
But cannot not get it to work for a specific row on the table
Thanks
Change
Set NewRow = tbl.ListRows.Add
to
Set NewRow = tbl.ListRows.Add(1)
If you don't specify the position, the row will always be added at the end. (You had it right in the first snippet.)
Related
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")
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'm trying to copy data rows from different tables and usually i would setup a conveluted setup
counting rows and columns and a couple of level deep for loops.
However, it appears the modern way to go is using listrows.
I tried going over the guide always referenced at https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
However i seem to miss this "sometable.listobject(1).rows = differentable.listrow(1).rows" roughly...
My code
Sub GenerateOverview()
Dim MainWs As Worksheet
Set MainWs = Worksheets("Overview")
Dim mainTbl As ListObject
Set mainTbl = MainWs.ListObjects(1)
' Later add for each sheet ----
Dim ws As Worksheet
Set ws = Worksheets("ABD") ' ABD to be replaced with activesheet.name LATER
Dim tbl As ListObject
Set tbl = ws.ListObjects(1)
Dim TopXRange As Integer
TopXRange = 10 ' to be changed to user defined range
Dim i As Integer
i = 0
For i = 1 To TopXRange
mainTbl.DataBodyRange.Rows(i) = tbl.DataBodyRange.Rows(i)
' THIS only produces empty cells on maintbl and not the content from tbl.
Next i
' end for each sheet ----
End Sub
Any advice?
Working solution for my task..
Sub GenerateOverview()
Dim MainWs As Worksheet
Set MainWs = Worksheets("Overview")
Dim mainTbl As ListObject
Set mainTbl = MainWs.ListObjects(1)
Dim ws As Worksheet
Dim TopXRange As Integer
TopXRange = 10
Dim i As Integer
i = 1
Dim tbl As ListObject
Dim newI
Dim mainRows As Integer
For Each ws In ThisWorkbook.Worksheets
If ws.Name = MainWs.Name Then GoTo skip
Set ws = Worksheets(ws.Name)
Set tbl = ws.ListObjects(1)
mainRows = mainTbl.ListRows.Count
If mainRows = 0 Then mainRows = 1
For i = newI To TopXRange
mainTbl.ListRows.Add (mainRows)
mainTbl.ListRows(mainRows).Range.Value = tbl.ListRows(i + 1).Range.Value
Next i
skip:
Next
End sub
Still not sure I follow. You probably need to insert a row into your second table before transferring. Something like this works:
Sub x()
Dim t1 As ListObject, t2 As ListObject
Set t1 = Sheet1.ListObjects("Table1")
Set t2 = Sheet1.ListObjects("Table2")
t2.ListRows.Add (3) 'insert new row 3 into second table
t2.ListRows(3).Range.Value = t1.ListRows(4).Range.Value 'transfer to new row from first table
End Sub
I have tables CustomerTable in Sheet1, and SalesTable in Sheet2.
CustomerTable has Customer_Code column (Col A), the formula is:
=[#[CustomerName ]] & [#[No order ]]
I want every time a new row is added in CustomerTable, the new record of Customer_Code in CustomerTable's Col A is added in SalesTable.
Like this:
MA18209 in CustomerTable's Col A appears in the last row of Customer_Code col (Col B) in SalesTable.
Code in Sheet1:
Sub CopyCustomerCode()
Dim A As String
Dim ws As Worksheet
Set ws = Sheets("Sheet2")
Dim otherRow As Long
otherRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1
ws.Cells(otherRow, 1).Value = b
End Sub
It does nothing.
The desirable state is for Excel to automatically copy the value in Col A, not by clicking a macro button.
How the row in CustomerTable is added? By inserting new row in the top of the table? Or by writing new info at the bottom and letting excel format is as new row?
You could write a macro for creating new row in CustomerTable and SalesTable at once. For some reason I like then newest entry is on top of the table so I always make button for inserting new rowo in row 2.
This code would add new row to SalesTable with on click_event (if your tables formatted as tables). If you want to avoid on click completely, you could try to use worksheet_change event.
Sub CopyCustomerCode()
Dim ws As Worksheet
Dim ws As Worksheet
Dim newRow As ListRow
Dim SalesTable As ListObject
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
'your table name here
Set SalesTable = ws2.ListObjects("Sales_Table")
'lines for determining last rows
With SalesTable.Range
LastRow .Rows(.Rows.Count).Row
End With
'add new row to bottom of the table
Set newRow = SalesTable.ListRow.Add
'copy info from column A in CustomerTable to SalesTable
With newRow
'if inserted row is row 2
.Range(2) = ws1.Range("A2").Value
End With
End Sub
Code for inserting new row for CustomerTable in row 2
Sub New_Row2()
Dim ws1 As Worksheet
Set ws1 = Sheets("Sheet1")
With ws1.Range("A2")
.EntireRow.Insert Shift:xlDown, CopyOrigin:xlFormatFromRightOrBelow
End With
End Sub
EDIT: If new entries in CutomerTable are added in the bottom, you could try finding last row of CustomerTable and using it in .Range(2) line.
Code should look something like this (you would have to add it to button_click procedure):
Sub CopyCustomerCode()
Dim ws As Worksheet
Dim ws As Worksheet
Dim newRow As ListRow
Dim CustomerTable As ListObject
Dim SalesTable As ListObject
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
'your table name here
Set SalesTable = ws2.ListObjects("Sales_Table")
'your table name here
Set CustomerTable = ws1.ListObjects("Cutomer Table")
'lines for determining last rows
With SalesTable.Range
LastRow = .Rows(.Rows.Count).Row
End With
With CustomerTable.Range
LastCusRow = .Rows(.Rows.Count).Row
End With
'add new row to bottom of the table
Set newRow = SalesTable.ListRow.Add
'copy info from column A in CustomerTable to SalesTable
With newRow
.Range(2) = ws1.Cells(LastCusRow, "A").Value
End With
End Sub