Within Excel, I use tables to store dynamic data inside a seperate worksheet. Entering new data works like a charm, however, I would like to be able to dynamically retrieve a single row from that table and store its data in variables. I would prefer to build a function so I could do something like this:
findFromCatsByDate(searchterm) 'returns a single row if found with mathing date.
Note that the table is dynamic and not a fixed range (so it changes vertically). I want to reuse this function with slight modification on other tables. I kind of need an example how to achieve this in VBA.
Thanks,
This will return a reference the row that matches Key in a specified table
Function GetRow(TableName As String, ColumnNum As Long, Key As Variant) As Range
On Error Resume Next
Set GetRow = Range(TableName) _
.Rows(WorksheetFunction.Match(Key, Range(TableName).Columns(ColumnNum), 0))
If Err.Number <> 0 Then
Err.Clear
Set GetRow = Nothing
End If
End Function
Example use
Sub zx()
Dim r As Range
Set r = GetRow("MyTable", 1, 2)
If Not r Is Nothing Then
r.Select
End If
End Sub
Related
I know how to count rows (and display the result in the form of a message form) using this syntax:
Sub CountRows1()
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox (last_row)
End Sub
I was wondering if there's another way to do it without declaring variables and instead, by selecting a range and then using offset.
I was thinking something along the lines of the follow, but no idea where to go from here:
Sub UseLoop ()
Range ("A1").Select
Do Until Active.Cell.Value = ""
-- Something to do the counting, can't seem to get this part right
ActiveCell.Offset (1,0).Select
Loop
End Sub
I want to access tables from a word document and I got a method that uses its index. But for my project, it arises confusion so I want to use their names as we can do in excel using this.
Set tbl = oExcelWorksheet.ListObjects("Table2").Range
But in word to access a table I only found this command
Set oTable = ActiveDocument.Tables("1")
Is there any other command in word VBA through which I can use the table name to access the table and not the index.
As #Timothy correctly pointed out in the comments, tables in word don't have names.
One way around is to bookmark the first cell (or any other cell) of each table with the name you want to give the table
Then you can use this bookmark to locate your table. For example you can use this function (I used suggestion from here) [Please see Edit1 below]
Function GetTable(sTableName As String) As Table
Dim sCell_1_Range As Range
With ThisDocument
On Error Resume Next
Set sCell_1_Range = .Bookmarks(sTableName).Range
If Err.Number > 0 Then Exit Function ' table not found
On Error GoTo 0
Set GetTable = .Tables(.Range(0, sCell_1_Range.End).Tables.Count)
End With
End Function
and use it like this
Sub TestTableWithName()
Dim myTable As Table
Set myTable = GetTable("SecondTable")
If Not myTable Is Nothing Then
myTable.Range.Select
End If
End Sub
Edit1
#freeflow suggested a much better implementation of the function
Function GetTable(sTableName As String) As Table
On Error Resume Next
Set GetTable = ThisDocument.Bookmarks(sTableName).Range.Tables(1)
End Function
Which means - depending on your coding style - you might not even need to use a function. Just remember to use On Error GoTo 0 if you use it directly
what I normally do is give unique title to the table in table properties of the table.
Then use a custom function.
Sub getTableByTitle()
Dim doc As Document
Dim tbl As Table
Set tbl = getTable("Tb1")
End Sub
Public Function getTable(s As String) As Table
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
If tbl.Title = s Then
Set getTable = tbl
Exit Function
End If
Next
End Function
I have two rows containing dates which I am trying to compare and see if they are the same. If not, I want to add the extra data (i.e. row 1 can change and so I want those changes added to row 2). Ive tried looking around and also writing my own loop but I`m getting an error.
UPDATE following the comment, i am still getting an error; "Unable to get the CountIf propety of the worksheetfunction class"
I am wondering if there are any alternatives to check if the data is present somewhere in the second row add add it if not.
I am new to vba and programming in general and any help would be appreciated.
Dim Dates As Range
Set Dates = Range("C23:O23")
Dim hisdate As Range
Set hisdate = Range("C35:O35")
For Each cell In Dates 'this is gonna first add new dates
If WorksheetFunction.CountIf(hisdate, cell) > 0 Then 'do nothing
Else
Set hisdate = Union(hisdate, cell)
End If
Next
As mentioned in the comments, WorksheetFunction.CountIf doesn't work with multi-area ranges. You could write your own countIf-function that loops over all areas (works even if the range is not a multi-area range)
Dim cell As Range
For Each cell In Dates 'this is gonna first add new dates
If MyCountIf(hisdate, cell) <= 0 Then
Set hisdate = Union(hisdate, cell)
End If
Next
Debug.Print hisdate.Address
Function MyCountIf(fullRange As Range, val As Variant)
MyCountIf = 0
Dim r As Range
For Each r In fullRange.Areas
MyCountIf = MyCountIf + WorksheetFunction.CountIf(r, val)
Next
End Function
I'll do my best to try and explain my problem, but it's still a bit fuzzy in my mind so this might not be as clear as it should be, for which I apologize in advance.
Here's the part of my code I'm having trouble with:
If Application.WorksheetFunction.countif(Range("D:D"), Cells(x, firstcolumn).Value) _
And Application.WorksheetFunction.countif(Range("F:F"), Cells(x, firstcolumn).Value) _
And Application.WorksheetFunction.countif(Range("H:H"), Cells(x, firstcolumn).Value) Then
The idea behind this project is to check if the values in "Cells(x, firstcolumn)" are present in columns D, F and H at the same time, and then paste the values somewhere else.
However the number of columns to check for the "Cells(x, firstcolumn)" values could be changed, so values would need to be checked in any number of columns (2, 10 etc). My code works perfectly for the specified Ranges but if one is missing or more are added then it stops working.
The columns to check against are always offset by 2 from the firstcolumn and firstcolumn is always B, it will be checked against D, F, H and so on while columns C,E,G etc have other data not relevant for this part.
My best guess is to have the countif Ranges changed dynamically but I'm at a loss of when and how this should be done...
Could anyone point me towards the right direction in order to achieve this? I can post the full code if needed.
Cheers!
You need to extract a function here. Something like this:
Private Function IsPresentInRange(ByVal source As Range, ByVal value As Variant) As Boolean
IsPresentInRange = Application.WorksheetFunction.CountIf(source, value) > 0
End Function
And then you need a way to figure out what ranges you need to give it for a source parameter - that can be a function of its own, or you can hard-code them somewhere; basically you want to have a concept of a group of ranges to call that function with - this would be the simplest:
Private Function GetSourceRanges() As Collection
Dim result As New Collection
result.Add Range("D:D")
result.Add Range("F:F")
result.Add Range("H:H")
'maintain this list here
Set GetSourceRanges = result
End Function
Ideally you would have some logic coded there, so that you don't need to manually add ranges to that collection every time.
And then you can just iterate these ranges and determine if you get a count > 0 for all of them:
Dim sources As Collection
Set sources = GetSourceRanges
Dim result As Boolean
result = True
Dim sourceRange As Range
For Each sourceRange In sources
result = result And IsPresentInRange(sourceRange, Cells(x, firstcolumn).Value)
Next
If result Then
' whatever you had in that If block
End If
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