I am adding a new row to a table but want to then add the data to that row that I just added. I am thinking something like this, but not sure how to add each columns data to that new row. My table has 4 columns named "store" "emp#" "date" & "amt". I have specific data that I will put in each column. I simplified the code, as there is a whole lot more to the macro, but just stuck on this part. Thank you for you help.
Dim rt_ws As Worksheet
Dim rt_tbl As ListObject
Set rt_ws = ThisWorkbook.Worksheets("RT Clock Hours")
Set rt_tbl = rt_ws.ListObjects("rt_hours")
With rt_table.ListRows.Add
. `this is where I am not sure what to do`
.
.
End Sub
Try this code
Sub Test()
Dim ws As Worksheet, tbl As ListObject
Set ws = ThisWorkbook.Worksheets("RT Clock Hours")
Set tbl = ws.ListObjects("rt_hours")
With tbl.ListRows.Add
.Range = Array("Store1", "1530", "05/03/2020", "Amt1")
End With
End Sub
Related
Hi have used the below code to remove the last row of data from a table. The code works ok in isolation but when run as part of a larger set of code it does not remove the last row. Any ideas on what is causing this and solution would be appreciated.
Sub TrimJrnl()
Dim wsR2 As Worksheet
Set wsR2 = ThisWorkbook.Sheets("Journal")
lastrow = wsR2.ListObjects("xJrnl").Range.rows.Count
rows(lastrow).Delete
End Sub
You need to count the rows of ListObjects("xJrnl").DataBodyRange so you know how many data rows are there (except header and summary rows).
You can access those data rows by ListObjects("xJrnl").ListRows(LastRow) and .Delete them.
Like Below:
Option Explicit
Public Sub TrimJrnl()
Dim wsR2 As Worksheet
Set wsR2 = ThisWorkbook.Sheets("Journal")
Dim LastRow As Long
LastRow = wsR2.ListObjects("xJrnl").DataBodyRange.Rows.Count
wsR2.ListObjects("xJrnl").ListRows(LastRow).Delete
End Sub
A nice guide how to work with tables: The VBA Guide To ListObject Excel Tables
I have a table in Sheet 2 with a name "MyTable". Number of rows of that table changes each time depending on the data. I would like to clear the contents of the table and resize it using a macro so that it has only two rows- a title row, and an empty row.
Table title row is from B5 until K5.
I tried the below code, it clears the table contents and resizes, however, does not resize as desired. It resizes, without clearing the table borders in column C.
Any help is really appreciated.
Sub Table_Resize()
Dim rng as Range
Sheet2.Select
Range("MyTable").ClearContents
Set rng = Range("MyTable[#All]").Resize(2, 10)
Sheet2.ListObjects("MyTable").Resize rng
End Sub
I think that what you are trying to do is to delete the all rows.
Sub Table_ClearContents_Resize()
Dim ws As Worksheet: Set ws = Sheets("Sheet2")
Dim ol As ListObject: Set ol = ws.ListObjects("MyTable")
' Delete table contents
ol.DataBodyRange.ClearContents
' Resize table
ol.Resize Range(ol.HeaderRowRange.Resize(2).Address)
End Sub
I have a table below another table.
If I add a lot of values in the first table, the second table will change cells and go further below.
Sub Macro4()
Range("Table2[Work]").Select
Selection.ListObject.ListRows.Add (1)
Range("A24").Value = Now
Range("B24").Value = VBA.Environ("Username")
End Sub
I'm using range (A24 and B24) to add values. I would rather have them follow up the table whatever it's location instead of hardcoding it.
Write to the Last Row of a Table
If you're trying to write to the last row of a table, try the following. Adjust the worksheet name though.
The Code
Option Explicit
Sub NewTableEntry()
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1") ' The worksheet containing the table.
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table2")
' If you fully understand the previous, then rather use the following:
'Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table2")
' Add a new row to the bottom of the table.
tbl.ListRows.Add
' Write values to the last row in the table.
With tbl.DataBodyRange.Rows(tbl.DataBodyRange.Rows.Count)
.Cells(1).Value = Now
.Cells(2).Value = VBA.Environ("Username")
End With
End Sub
I want to insert the following formula into the third column of my Excel Table "Transactions". If I enter it manually, it works, but if I try to enter it using a subroutine I get the Error 1004. Not sure how to solve this. Here is a code snippet:
Sub test3()
Dim ws As Worksheet
Dim lo As ListObject
Dim lCol As ListColumn
Set ws = ThisWorkbook.Worksheets("Transactions")
Set lo = ws.ListObjects(1)
Set lColName = lo.ListColumns(3)
lColName.DataBodyRange.Formula = "=IFERROR(INDEX(Staff[CREDENTIALS],MATCH([#[Staff, Last Name]],LastName,0)),"")"
End Sub
All I really need to do is to put the formula into the first row of the table (row 2) in the third column "Staff, Credentials". It is pulling from another Excel Table "Staff".
I believe the issue is coming from your formula (I know you mentioned it works when you manually enter it however when I try I'm getting an error), try changing [#[Staff, Last Name]] to Staff[Last Name]
Also, you'll need to escape the "" in the IFERROR formula, the below code should work:
Sub test3()
Dim ws As Worksheet
Dim lo As ListObject
Dim lCol As ListColumn
Set ws = ThisWorkbook.Worksheets("Transactions")
Set lo = ws.ListObjects(1)
Set lColName = lo.ListColumns(3)
lColName.DataBodyRange.Formula = "=IFERROR(INDEX(Staff[CREDENTIALS],MATCH(Staff[Last Name],LastName,0)),"""")"
End Sub
I have a dataset on Worksheet "Results" and the dataset is in cells B8:K900 (Actual data in these cells, rest all cells have other meta information this dataset)
Each column of this data set refers to a certain variable like B column has Steam flow, C column has Steam temp etc.
I would like to use these values to plug into a calculator on another sheet, Row by row.
Eventually I will have results in 2 Cells on another sheet which I would like to bring back to Column L and M
Code so far, (I am getting error on first line "ws1.Range("B").Copy Destination:=ws2.Range("B6")" while debugging) :
Note: Goal Seek and Rerun are 2 macros which I would like run after one row of Scenario is in input, as these will help to get results. Hence I have added them in loop also
Any help would be appreciated.
Sub Goal_Seek()
Range("I33").GoalSeek Goal:=Range("P33").Value, ChangingCell:=Range("E3")
End Sub
Sub Rerun()
Do Until Range("P20") = Range("P22").Value
Range("P20") = Range("P22").Value
Loop
End Sub
Sub Calcs()
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim rng As Range
Set wb = ActiveWorkbook
Set ws1 = wb.Worksheets("Results")
Set ws2 = wb.Worksheets("PI Data")
Set ws3 = wb.Worksheets("Mole_avg")
Set ws4 = wb.Worksheets("eff")
Set ws5 = wb.Worksheets("FlueGas")
Set rng = ws1.Range("B8:M9")
For Each Row In rng.Rows
ws1.Range("B").Copy Destination:=ws2.Range("B6")
ws1.Range("C").Copy Destination:=ws2.Range("B3")
ws1.Range("D").Copy Destination:=ws2.Range("B4")
ws1.Range("E").Copy Destination:=ws2.Range("B5")
ws1.Range("G").Copy Destination:=ws2.Range("B7")
ws1.Range("H").Copy Destination:=ws2.Range("B8")
ws1.Range("I").Copy Destination:=ws2.Range("B9")
ws1.Range("J").Copy Destination:=ws2.Range("B10")
ws1.Range("K").Copy Destination:=ws2.Range("B11")
Application.Run "Goal_Seek"
Application.Run "Rerun"
ws3.Range("P17").Copy Destination:=ws1.Range("L")
ws3.Range("T22").Copy Destination:=ws1.Range("M")
Next Row
End Sub