VBA Dynamic Table (ListObject) - sql

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.

Related

Excel VBA verify if all fields in a column in a table are filled before saving

I am having troubles with a VBA code I want to write. I have looked through different questions here and in other forums but I cant find something that will help my needs.
My problem is about a table named "TableLaw", with about 43 columns and over 10000 rows.
Practically, my need can be divided in two parts:
Verify all fields in column [Comments] from TableLaw. Meaning, I want to see if all data fields in that column are not empty. So I will need to check over 10000 rows. Please note: the fields I am verifying have a formula in them, so they are not really empty. The formula concatenates some cells to form a comment. I need to see if there is a comment or not in each cell
If there are empty fields in the column [Comments], I want to block the workbook from saving. I would like to also highlight the cells that are 'empty' in the column to help the user see which field in the column he needs to work on.
I have no problems with the blocking from saving part, but I am having serious trouble with even forming a For Each or something that will iterate from cell to cell in the column [Comment] checking if the cell is empty or it has a formula only and highlight those cells which are empty.
It is important to use structure names like [Comments] because the user might add new columns to the table.
Thanks, and sorry for the trouble. I am relatively new to VBA and my prior knowledge in programming is few.
I have seen lots of complicated code snippets that I just can not understand, but I got this and I am sure all of you will laugh at my incompetence and doubt if I really did something:
Sub TableTest()
Dim tbl As ListObject
Dim tRows As Long
Dim tCols As Long
Dim lo As ListObject
Dim ws As Worksheet
Dim lr As ListRow
Dim lc As ListColumn
'I used this to get the column number and then use it in a For cycle to go through all cells in the column
col = WorksheetFunction.Match("COMMENTS", Sheets("Orders").Range("5:5"), 0)
Set tbl = ActiveSheet.ListObjects("TableLaw")
With tbl.DataBodyRange
tRows = .Rows.Count
tCols = .Columns.Count
End With
Set ws = ThisWorkbook.Worksheets("Orders")
Set lo = ws.ListObjects("TableLaw")
For Each lr In lo.ListRows
Cells(lr, col).Interior.ColorIndex = 37
Next lr
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'I added the range like this because I do not know how to add the column name.
If WorksheetFunction.CountA(Worksheets("Orders").Range("AM6:AM10500")) <> "" Then
MsgBox "Workbook will not be saved unless all comments are added"
Cancel = True
End If
End Sub
You can check it with the .Value function
ie.
If (Range("A1").Value = "") Then
''' PROCESS CODE
End If

Selecting a table of data VBA

I am very new to VBA/coding and so I'm in need of some help and so will likely be posting on here quite a bit within the next few weeks. I have been teaching myself as much as I can over the last week or so and I have decided to start a project.
I need to select and copy a table of data but the problem is the table of data changes size every single day so I cannot set a specific range. The code I am using is this but it isn't selecting the whole table.
Workbooks.open "filepath\filename.xls"
Workbooks ("filename.xls").Activate
Range ("b8").Select
Range (Selection, Selection.end(xlDown)).Select
Range (Selection, Selection.end(xlToRight)).Select
The attached picture is the table and the first cell with data in is b8(Target SLA & Category) and I want it to copy down to the bottom right of the image. as i have stated the table changes size each day so I can't have a set range. Table Data
You can select the table instead of a range of cells (change "Table1" to whatever your table is named).
ActiveSheet.ListObjects("Table1").Range.Select
Given that the overall design of your table does not change (i.e. the first observation is always in cell B8) you can use
Sub SelectData()
Dim rngData As Range
Set rngData = Worksheets("Table1").UsedRange
rngData.Offset(7, 1).Resize(rngData.Rows.Count - 7, rngData.Columns.Count - 1).Select
End Sub
In case there can be changes, the following should be quite robust:
Sub SelectData()
Dim rngData As Range
Dim intRow As Integer
Dim intColumn As Integer
intRow = Range("Table1!FirstDataPoint").Row
intColumn = Range("Table1!FirstDataPoint").Column
Set rngData = Worksheets("Table1").UsedRange
rngData.Offset(intRow - 1, intColumn - 1).Resize(rngData.Rows.Count - intRow + 1, rngData.Columns.Count - intColumn + 1).Select
End Sub
In order to apply this you have to name the upper left data point, in your case cell B8 (I used the name "FirstDataPoint"). When you insert rows or columns to the left or above of this cell the code should still work.

Deleting and adding items in a table Excel 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

Excel VBA - Add or Reduce Amount in cell from cell reference

I'm trying to look for some VBA Code that can reduce the Quantity in stock whenever there is Item issued in Invoice. For Example if "Keyboard" and "Mouse" item issued by 2 and 3 then the number should automatically reduce in in Stock "Quantity" Column for respected item
I already search for the solution and couldn't get one. Hope you guys can help me.
Thank you in advance.
If you could add some more information about where the values are, and how your invoice event is called it would help.
Are you running this through a Form? or on a worksheet? If there are textBoxes with information, just use those when you declare your input variables below.
Anyway. This could easily be condensed, but I'm laying it out in a more informative way so you can learn the concepts behind it instead of the most concise code.
EDITED WITH REVISED CODE: After Comments with details. SEE PIC
Sub InventoryUpdate()
Dim qtyIn As Integer
Dim qtySold As Integer
Dim sheeteName As String
Dim iRow As Integer
Dim lastStockRow As Integer
Dim lastInvoiceRow As Integer
Dim tProduct As String
Dim sRow As Integer
'Declare the sheetName here once, so you don't have to replace it every time it changes
sheetName = "Sheet1"
'Determine the last rows, unless you know it already, then ignore this.
lastInvoiceRow = Sheets(sheetName).Range("B65536").End(xlUp).Row
lastStockRow = Sheets(sheetName).Range("E65536").End(xlUp).Row
'Loop through the rows of your table. Since you know the range, it's rows 4-10
For iRow = 4 To lastInvoiceRow
'Set the temp Product name as row, Column B, and the Qty Sold from Column C
tProduct = Sheets(sheetName).Cells(iRow, 2)
qtySold = Sheets(sheetName).Cells(iRow, 3)
For sRow = 4 To lastStockRow
If Sheets(sheetName).Cells(sRow, 5) = tProduct Then
qtyIn = Sheets(sheetName).Cells(sRow, 6)
Sheets(sheetName).Cells(sRow, 6) = qtyIn - qtySold
Exit For
End If
Next sRow
Next iRow
End Sub

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