I am a beginner. I have been trying to teach myself VBA and researching this question for two weeks, including reviewing all the relevant answers on this forum. I give up!
I am trying to loop through the rows of a table to select a table row based on the content of one of the row's cells (naming a particular column). I want to use the name of the table column. But something is wrong with my "If ... Then" statement. I get errors with every attempt. Right now I get a compile error "Expected Then or Go To," with the period before Value highlighted. But I have a feeling that if I fixed that error there would be another one right behind it. What am I getting wrong, besides trying to learn this on my own? ;>)
Thanks in advance!
Sub CommandButton1_Click()
Dim tbl As ListObject
Dim x As Long
Set tbl = ActiveSheet.ListObjects("Table1")
For x = 1 To tbl.Range.Rows.Count
If (Range("Table1[Status]")).Value = "Completed"
'I can't seem to find the right statement to put between If and .Value!
Rows(x).Select
End If
Next x
End Sub
Change If (Range("Table1[Status]")).Value = "Completed" to If (Range("Table1[Status]").Value) = "Completed" Then. Your .Value just needed to be put in the brackets. I would also highly suggest looking into the Rubberduck add-in for VBA. It has an Auto Indenter so your code always looks in order.
Sub CommandButton1_Click()
Dim tbl As ListObject
Dim x As Long
Dim myRange As Range
Set tbl = ActiveSheet.ListObjects("Table1")
For x = 1 To tbl.Range.Rows.Count
If tbl.DataBodyRange(x, Range("Table1[Status]").Column) = "Completed" Then
If myRange Is Nothing Then
Set myRange = tbl.ListRows(x).Range
Else
Set myRange = Union(myRange, tbl.ListRows(x).Range)
End If
End If
Next x
myRange.Select
End Sub
Related
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 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
The variable tablelength counts how many items are in a table of mine. I want to select my entire table, but it varies in sizes so my range has to include a variable. I've googled a lot and searched this site (Using variables in Excel range <- that method looked promising but didn't work). Below is a snippet of my code, but includes everything that is relevant.
Private Sub CommandButton1_Click()
Dim shSource As Worksheet
Dim shDest As Worksheet
Dim tablelength As Integer
Set shDest = ThisWorkbook.Sheets("Sheet2")
'here comes some code that determines the value of tablelength, which is 8 in this case
shDest.Range("L" & "4" & ":" & "M" & tablelength).Select
End Sub
I appreciate the help.
edit: the debugger highlights the shDest.Range code.
Unless you need tablelength variable somewhere else in the code, you could try using:
shDest.Range("L4").CurrentRegion.Select
CurrentRegion.Select will select all cells starting from "L4" until it reaches a blank row and column, so providing your tables are surrounded by blank cells this should select the whole table regardless of the size
Here you go, try this:
ActiveSheet.Range(Cells(2, 3), Cells(10, 4)).Select
Taken from http://support.microsoft.com/kb/291308
The first parameter to Cells is the row and the second is the column as a number.
So for you it would look something like this:
shDest.Range(Cells(4, 12), Cells(tablelength, 13)).Select
If it's a proper Table on the spreadsheet, and not just cells formatted to look like a table, you can directly refer to the 'live' size of the table in your code without jumping through all these hoops.
In your VBA code,
The 'Table' is referred to as a ListObject
You can declare a new ListObject, and look up its DataBodyRange.Rows.Count
This should work:
Sub MyMacro()
Dim Tabl As ListObject
Set Tabl = Worksheets("Sheet1").ListObjects("Table1")
MsgBox Tabl.DataBodyRange.Rows.Count
End Sub
You can also set a range variable to refer to the 'Data' range. You need to use the following code.
Dim Rng As Range
Set Rng = Worksheets("Sheet1").ListObjects("Table1").DataBodyRange
Now Rng.Cell(1,1) or Rng.Range("A1") refers to the top left cell of the data body and so on and so forth...
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
Similar issue to these:
Find the differences between 2 Excel worksheets?
Compare two excel sheets
My issue specifically, I have a monthly employee listing with a unique ID and around 30 columns of other data for around 900 employees.
I'm trying to accomplish two things:
Compare if employees were added or dropped between the lists.
Between the sheets for each employee compare what other data for that employee changed. i.e. Job Title changed.
Most compare add-ins/modules I find only compare the specific ranges in order, thus once once difference if found every subsequent row will be different.
First, I'm wondering if there are any existing tools that can do this. If not I was thinking of building my own. I was thinking of doing this by looping through each employee and using vlookup to verify matches. I'm concerned doing this many loops will make the macro difficult to use. Any guidance on how I should go about this? Thanks.
Untested, but will give you a place to start from...
This does not find ex-employees which are on the "old" sheet but not on the "current" sheet.
Sub CompareEmployeeInfo()
Const ID_COL As Integer = 1 ' ID is in the first column
Const NUM_COLS As Integer = 30 'how many columns are being compared?
Dim shtNew As Excel.Worksheet, shtOld As Excel.Worksheet
Dim rwNew As Range, rwOld As Range, f As Range
Dim x As Integer, Id
Dim valOld, valNew
Set shtNew = ActiveWorkbook.Sheets("Employees")
Set shtOld = ActiveWorkbook.Sheets("Employees")
Set rwNew = shtNew.Rows(2) 'first employee on "current" sheet
Do While rwNew.Cells(ID_COL).Value <> ""
Id = rwNew.Cells(ID_COL).Value
Set f = shtOld.UsedRange.Columns(ID_COL).Find(Id, , xlValues, xlWhole)
If Not f Is Nothing Then
Set rwOld = f.EntireRow
For x = 1 To NUM_COLS
If rwNew.Cells(x).Value <> rwOld.Cells(x).Value Then
rwNew.Cells.Interior.Color = vbYellow
Else
rwNew.Cells.Interior.ColorIndex = xlNone
End If
Next x
Else
rwNew.Cells(ID_COL).Interior.Color = vbGreen 'new employee
End If
Set rwNew = rwNew.Offset(1, 0) 'next row to compare
Loop
End Sub
Don't know if there is anything that does that for you or not. But, you can use the Dictionary Object to make this comparison task much easier. You can also take examples from this answer that uses Dictionaries which checked for uniques and is optimized for speed, change it to what you need. Then you can use this fast method to color the cells or whatever you want to do with it.
I know I'm not providing code for you but these pointers will get you started, and if you have more questions I can help you out.