Deleting and adding items in a table Excel VBA - vba

I've got a problem with filling a table.
The table will be filled with data after a combobox is changed. First off I want to delete the data that's in the table and after that add the data I want.
What I have got is this (This is just a part of the code, the collection is already filled with data)
Dim TableListObject As ListObject
Dim TableObjectRow As ListRow
Dim i As Integer
Dim CollWerknemer as Collection
Set TableListObject = TheSheet.ListObjects(1)
Set TableObjectRow = TableListObject.ListRows.Add
TableListObject.DataBodyRange.Delete
i = 1
For Each vNum In CollWerknemer
TableObjectRow.Range(i, 1) = vNum
i = i + 1
Next vNum
The problem is that it does delete the table but doesn't add anything.
If I exclude the TableListObject.DataBodyRange.Delete from the code it does fill the table with the data that I want, but if I change my combobox the new data will be added at the bottom instead of clearing the table first.

First you could iterate each row in the current table, and remove its content, then use the ListRows.Add
With outTBL
If .ListRows.Count >= 1 Then
.DataBodyRange.Delete
End If
End With
Dim row as ListRow
Set row = outTBL.ListRows.Add
row.Range(x, x) = vNum

Related

VBA Dynamic Table (ListObject)

So, after some research I miss something somewhere... First, I linked my SQL recordset to my spreadsheet so I managed to fetch 9999 rows and 16 columns starting by Cell "B21". Onto this, I created a table named "MyScreener" with this piece of code:
Sub Create_Table()
Dim Rn As Range
Set Rn = shtEquity.Range("B21").CurrentRegion
Dim tbl As ListObject
Set tbl = shtEquity.ListObjects.Add(xlSrcRange, Rn, xlYes)
With tbl
.Name = "MyScreener"
.TableStyle = "TableStyleMedium18"
End With
End Sub
Cool so now I have a new column to add to my table, I tried some pieces of code like this one for example:
Dim tbl As ListObject
Dim lrow As Integer
Dim lcol As Integer
Set tbl = shtEquity.ListObjects("MyScreener")
lrow = tbl.Range.Rows.count
lcol = tbl.Range.Columns.count
tbl.Resize tbl.Range.Resize(lrow, lcol)
This one compile but does nothing, giving lrow = 9980 and lcol = 16 which is obviously does not taking into account my last (an seventeenth) column.
Is there anyone that can just give a tip to create a table that dynamically updates itself when I fetch a new request ? Like each request, SQL send new amount of rows and as it's linked with my sspreadsheet already it would be nice that the table within the spreadhseet updates too.
Hope my explanation will be clear enough.
Thanks in advance for looking at !
I'm a little confused.
Ordinarily, if you've already added a column to the table, it will resize.
If this code is to enlarge the table to create an extra column first, then you have to add one (1) to the current column count.
So:
tbl.Resize tbl.Range.Resize(lRow, lCol + 1)
By the way, you should declare lrow and lcol as Long and not Integer.
Integer will limit your rows to 32767, and, internally, integers get converted to Longs anyway.

Different sections in a table (multiple empty rows). Create a conditional loop that inputs an empty row to the correct section - VBA

I have an issue I'm unable to resolve myself and was wondering if anyone here could help me. I have table with a lot of values which are broken down into different sections (separated by an empty row). I need to be able to control where a new row is inserted with the use of a macro.
What I would like to do is to create a macro with conditions so that I can control where an empty row are to be inserted. My take is to create separate buttons next to each sections (before an empty row) that assigns a value so that loop may skip through x number of empty rows before inserting a new row. My first take is like this:
Sub InsertNewRow()
Dim erow As Integer
Dim number As Integer 'number of empty rows to skip
Dim count As Integer 'to keep track on number of empty rows to skip
Dim LastRow As Long
erow = ActivityInput.UsedRange.Rows.count
count = 0
For Each l In erow
Do While i <> ""
Next erow
count = count + 1
If element = count Then
'Cells(Rows.count, 1).End(xlUp).Offset(1, 0).EntireRow.Insert
'This is as far as I got. I don't know how to make the macro go to the last row of the current section... any suggestions?
..
To clarify, I would like to add macro(s) (bottons) that helps the user to insert new rows. If the user is at section 3 (2 empty rows have been passed which separates the different sections), I would like the user to be able to click on the macro (button) which then subsequently adds a new row to the current section.
Any ideas?:/
Regards,
Alexander
Sub InsertNewRow(X As Integer)
Dim count As Integer
count = 0
For i = 1 To ActivityInput.Range("X[ABC]")(i)
If i <> "" Then Next i
ElseIf X = count Then
Cells(l, 1).End(xlDown).Offset(1, 0).EntireRow.Insert
Else
count = count + 1
Next l
End Sub

Adding a row after first row in a Table having only one row

I need to add a row after first row in MSWord Document. Document have already one row and two columns containing Country in first cell and Partner in second cell as values of both cells. Problem with the following code is it only work with at-least two rows.
Macro should be able to add row and write predefined strings in both columns. This can be done in two ways
By adding a row at the end of the table and reaching to it and writing the strings. If i do this then my question is how can I reach to the last row of the table?
By adding second row Everytime as mentioned in the following code.
Set doc = Documents.Open("C:\Users\dell\Desktop\LATAM.DOCX", , , , , , , , , , , True)
Set rng = doc.Content
rng.Tables(1).Rows.Add (rng.Tables(1).Rows(2)) 'Here I am getting error 'required memeber of collect not exist.
Set Cell = rng.Tables(1).Cell(2, 1)
Set Cell2 = rng.Tables(1).Cell(2, 2)
Cell.Range.Text = UT
If UT = "CROATIA" Then Cell2.Range.Text = "ERSTE SECURITIES ZAGREB"
If UT = "CZECH REPUBLIC" Then Cell2.Range.Text = "ERSTE GROUP"
Latam.docx look like this:
Requirement: After Macro it should be like this with values in added cells.
UPDATED ANSWER:
Set doc = Documents.Open("C:\Users\ibnea\Desktop\List of Countries & Companies CEEMEA & LATAM.DOCX", , , , , , , , , , , True)
Set rng = doc.Content.Tables(1).Rows.Add
rng.Range.Font.Bold = False
rng.Cells(1).Range = UT
rng.Cells(2).Range = UT2
Maybe I don't really understand your question but when I open a Word File and create a table with 1 row (as header) and 2 columns and enter "Country" and "Partner" then I can create a new row in this table with this code:
Option Explicit
Sub addRow()
Dim tbl As Table
'set tble variable to Table with Index 1 in your document
Set tbl = ActiveDocument.Tables(1)
'add a row to this table at the end
tbl.Rows.Add
'get last row in this table
Dim lastRow As Variant
lastRow = ActiveDocument.Tables(1).Rows.Count
'write to the last row
ActiveDocument.Tables(1).Cell(lastRow, 1).Range = "your value in last row / column 1"
ActiveDocument.Tables(1).Cell(lastRow, 2).Range = "your value in last row / column 2"
End Sub
You said your list has only one row. This code now adds a row and fills in column 1 and 2 the value whatever is on the right side of the equality sign. It's still not clear what UT is and where it comes from. But anyway you can now access the last cells with this code.
Use Rows.Add without a parameter and the new row will be inserted at the end of the table. The parameter (as stated in the Help topic for Rows.Add enables code to insert new rows before a specific row.
In order to work with the new row, declare an object variable and assign the row to it when it's created. It's also a good idea to do this with the Table object. That way it's possible to address the objects directly, rather than needing to always use something like rng.Tables(index).Rows(index) not only is this simpler to read and write, it also executes more quickly.
So, based on the code in the question my recommendation:
Dim tbl as Word.Table, rw as Word.Row
Set tbl = rng.Tables(1)
Set rw = tbl.Rows.Add
rw.Cells(1).Range.Text = "cell content"
rw.Cells(2).Range.Text = "other cell content"

Copy values from multiple columns in same row VBA

I'm a VBA noob with a massive table of analysis results where each row is containing results from a different date. I'm looking for values in certain columns, and they are some times empty. When they are, I'm not interested in them. The values I want are supposed to be copied to a new sheet to be collected in a smaller table.
I have written a script where I loop through the rows in the masterTable, and I am able to identify the rows with the values I'm interested in. However, I am not able to copy the value from the different cells in the identified row to a new sheet.
I've tried using Union to make a range inlcuding the columns that are relevant for copying.
Dim searchCells As Range
Dim masterTable As Range
Set searchCells = Union(Columns("R"), Columns("S"), Columns("T"), Columns("X"), Columns("Z"), Columns("AF"), Columns("AQ"), Columns("AT"), Columns("AY"), Columns("AV"), Columns("BB"), Columns("BD"), Columns("BG"))
Set masterTable = Worksheets("Sheet0").Range("A3:BG2022")
a = 1
For i = 1 To masterTable.Rows.Count
If Application.WorksheetFunction.CountA(searchCells(i).Value) <> 0 Then ' look for values among the relevant columns in row(i).
Debug.Print "Found data at "; i
Worksheets("Sheet0").searchCells.Rows(i).Copy ' copy data from searchCells
Worksheets("Results").Range("C1").Offset(a, 0).paste ' paste data to destination
a = a + 1 ' increment destination row offset
End If
Next
My idea of the searchCells are not working, as I "find data" in all rows, and I'm not able to run the .Copy and the .Paste methods. All help is appreaciated!
EDIT: upon compilation VBA throws the following error on the copy-line:
Run-time error '438':
Object doesn't support this property or method
To copy the relevant rows (for those columns only) where there is data in at least one cell, you could use:
Dim searchCells As Range
Dim masterTable As Range
Dim rRow As Range
Set searchCells = Range("R:T,X:X,Z:Z,AF:Af,AQ:Aq,AT:AT,AV:AV,AY:AY,BB:BB,BD:BD,BG:BG")
Set masterTable = Worksheets("Sheet0").Range("A3:BG2022")
a = 1
For i = 1 To masterTable.Rows.Count
Set rRow = Intersect(searchCells, searchCells.Cells(i, 1).EntireRow)
If Application.WorksheetFunction.CountA(rRow) <> 0 Then ' look for values among the relevant columns in row(i).
Debug.Print "Found data at "; i
rRow.Copy Worksheets("Results").Range("C1").offset(a, 0) ' paste data to destination
a = a + 1 ' increment destination row offset
End If
Next

Add new row to excel Table (VBA)

I have an excel which serves to record the food you ingest for a specific day and meal. I hav a grid in which each line represent a food you ate, how much sugar it has, etc.
Then i've added an save button to save all the data to a table in another sheet.
This is what i have tried
Public Sub addDataToTable(ByVal strTableName As String, ByRef arrData As Variant)
Dim lLastRow As Long
Dim iHeader As Integer
Dim iCount As Integer
With Worksheets(4).ListObjects(strTableName)
'find the last row of the list
lLastRow = Worksheets(4).ListObjects(strTableName).ListRows.Count
'shift from an extra row if list has header
If .Sort.Header = xlYes Then
iHeader = 1
Else
iHeader = 0
End If
End With
'Cycle the array to add each value
For iCount = LBound(arrData) To UBound(arrData)
**Worksheets(4).Cells(lLastRow + 1, iCount).Value = arrData(iCount)**
Next iCount
End Sub
but i keep getting the same error on the highlighted line:
Application-defined or object-defined error
What i am doing wrong?
Thanks in advance!
You don't say which version of Excel you are using. This is written for 2007/2010 (a different apprach is required for Excel 2003 )
You also don't say how you are calling addDataToTable and what you are passing into arrData.
I'm guessing you are passing a 0 based array. If this is the case (and the Table starts in Column A) then iCount will count from 0 and .Cells(lLastRow + 1, iCount) will try to reference column 0 which is invalid.
You are also not taking advantage of the ListObject. Your code assumes the ListObject1 is located starting at row 1. If this is not the case your code will place the data in the wrong row.
Here's an alternative that utilised the ListObject
Sub MyAdd(ByVal strTableName As String, ByRef arrData As Variant)
Dim Tbl As ListObject
Dim NewRow As ListRow
' Based on OP
' Set Tbl = Worksheets(4).ListObjects(strTableName)
' Or better, get list on any sheet in workbook
Set Tbl = Range(strTableName).ListObject
Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
' Handle Arrays and Ranges
If TypeName(arrData) = "Range" Then
NewRow.Range = arrData.Value
Else
NewRow.Range = arrData
End If
End Sub
Can be called in a variety of ways:
Sub zx()
' Pass a variant array copied from a range
MyAdd "MyTable", [G1:J1].Value
' Pass a range
MyAdd "MyTable", [G1:J1]
' Pass an array
MyAdd "MyTable", Array(1, 2, 3, 4)
End Sub
Tbl.ListRows.Add doesn't work for me and I believe lot others are facing the same problem. I use the following workaround:
'First check if the last row is empty; if not, add a row
If table.ListRows.count > 0 Then
Set lastRow = table.ListRows(table.ListRows.count).Range
For col = 1 To lastRow.Columns.count
If Trim(CStr(lastRow.Cells(1, col).Value)) <> "" Then
lastRow.Cells(1, col).EntireRow.Insert
'Cut last row and paste to second last
lastRow.Cut Destination:=table.ListRows(table.ListRows.count - 1).Range
Exit For
End If
Next col
End If
'Populate last row with the form data
Set lastRow = table.ListRows(table.ListRows.count).Range
Range("E7:E10").Copy
lastRow.PasteSpecial Transpose:=True
Range("E7").Select
Application.CutCopyMode = False
Hope it helps someone out there.
I had the same error message and after lots of trial and error found out that it was caused by an advanced filter which was set on the ListObject.
After clearing the advanced filter .listrows.add worked fine again.
To clear the filter I use this - no idea how one could clear the filter only for the specific listobject instead of the complete worksheet.
Worksheets("mysheet").ShowAllData
I actually just found that if you want to add multiple rows below the selection in your table
Selection.ListObject.ListRows.Add AlwaysInsert:=True works really well. I just duplicated the code five times to add five rows to my table
I had the same problem before and i fixed it by creating the same table in a new sheet and deleting all the name ranges associated to the table, i believe whene you're using listobjects you're not alowed to have name ranges contained within your table hope that helps thanks
Ran into this issue today (Excel crashes on adding rows using .ListRows.Add).
After reading this post and checking my table, I realized the calculations of the formula's in some of the cells in the row depend on a value in other cells.
In my case of cells in a higher column AND even cells with a formula!
The solution was to fill the new added row from back to front, so calculations would not go wrong.
Excel normally can deal with formula's in different cells, but it seems adding a row in a table kicks of a recalculation in order of the columns (A,B,C,etc..).
Hope this helps clearing issues with .ListRows.Add
As using ListRow.Add can be a huge bottle neck, we should only use it if it can’t be avoided.
If performance is important to you, use this function here to resize the table, which is quite faster than adding rows the recommended way.
Be aware that this will overwrite data below your table if there is any!
This function is based on the accepted answer of Chris Neilsen
Public Sub AddRowToTable(ByRef tableName As String, ByRef data As Variant)
Dim tableLO As ListObject
Dim tableRange As Range
Dim newRow As Range
Set tableLO = Range(tableName).ListObject
tableLO.AutoFilter.ShowAllData
If (tableLO.ListRows.Count = 0) Then
Set newRow = tableLO.ListRows.Add(AlwaysInsert:=True).Range
Else
Set tableRange = tableLO.Range
tableLO.Resize tableRange.Resize(tableRange.Rows.Count + 1, tableRange.Columns.Count)
Set newRow = tableLO.ListRows(tableLO.ListRows.Count).Range
End If
If TypeName(data) = "Range" Then
newRow = data.Value
Else
newRow = data
End If
End Sub
Just delete the table and create a new table with a different name. Also Don't delete entire row for that table. It seems when entire row containing table row is delete it damages the DataBodyRange is damaged