VBA: Counting rows in a table (list object) - excel

I am trying to write some VBA in Excel that can take the name of a table (list object) as a parameter and return the number of rows.
The following works, but isn't allowing me to pass in a string with the table name.
MsgBox ([MyTable].Rows.Count)
The following gives the error:
Object required
v_MyTable = "MyTable"
MsgBox (v_MyTable.Rows.Count)
The following gives the error:
Object variable or With block variable not set
v_MyTable_b = "[" & "MyTable" & "]"
MsgBox(v_MyTable_b.Rows.Count)
I also tried working with ListObjects, which I am new to. I get the error:
Object doesn't support this property or method
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("MyTable")
MsgBox(tbl.Rows.Count)
Thanks for any help!

You need to go one level deeper in what you are retrieving.
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("MyTable")
MsgBox tbl.Range.Rows.Count
MsgBox tbl.HeaderRowRange.Rows.Count
MsgBox tbl.DataBodyRange.Rows.Count
Set tbl = Nothing
More information at:
ListObject Interface ListObject.Range Property ListObject.DataBodyRange Property ListObject.HeaderRowRange Property

You can use this:
Range("MyTable[#Data]").Rows.Count
You have to distinguish between a table which has either one row of data or no data, as the previous code will return "1" for both cases.
Use this to test for an empty table:
If WorksheetFunction.CountA(Range("MyTable[#Data]"))

You can use:
Sub returnname(ByVal TableName As String)
MsgBox (Range("Table15").Rows.count)
End Sub
and call the function as below
Sub called()
returnname "Table15"
End Sub

Related

How do I join the word "Sheet" and an integer to form sheet code name

How can I concatenate the word "Sheet" with a number (say, 2) to form a string that can be used as the code name of a sheet.
I've tried the following piece of code but it doesn't seem to work.
Sh = "Sheet" & 2
Range("A1") = Sh.index
If you want to refer the sheet just based on index you could try something like this as well ... hope it works for you
Sub trial()
i = 2
Sheets(i).Select
End Sub
I assume you want to check if a given ►string argument (CodeNameString) refers to a valid Code(Name) in the VBA project. *)
If so, the following function returns the worksheet to be set to memory; otherwise the second argument IsAvailable passed by reference will change to False and can be used for error checks (c.f. ExampleCall below).
Function SheetByCodename(ByVal CodeNameString As String, ByRef IsAvailable As Boolean) As Object
'check for same CodeName in Sheets collection
Dim ws As Object
For Each ws In ThisWorkbook.Sheets
If ws.CodeName = CodeNameString Then ' check for string identity
Set SheetByCodename = ws ' set sheet object to memory
IsAvailable = True ' assign true to 2nd argument passed ByRef
Exit For
End If
Next
End Function
Example call
Sub ExampleCall()
dim cnt As Long: cnt = 2 ' << change example counter
Dim okay As Boolean ' << needed variable passed as 2nd function argument
With SheetByCodename("Sheet" & cnt, okay)
If okay Then
Debug.Print _
"a) Worksheet Name: " & .Name & vbNewLine & _
"b) Sheet's Code(Name) in Project: " & .CodeName
Else
Debug.Print "Given string refers to no valid Code(Name)."
'do other stuff to handle the wrong input
End If
End With
End Sub
*) Take note of #RonRosenfeld 's important remarks in comment:
"Codename is assigned when the worksheet is created. It can be changed in the properties window. In order to change it programmatically, you need to enable Trust Access to the VBA object model. Otherwise, it's a read-only property. "

Index match in VBA referencing a table

I want to update a line in my table based on a cell in another sheet, and to that end I intend to use the index match function. When I run the code below I get the error that it cannot get the property of the match function class.
What is the correct syntax in this regard?
Sub Update_Customer()
' Declarations
Dim rng as listobject
Dim wf as application.worksheetfunction
Dim cs_sht as string
Set rng = Sheets(1).ListObjects("Table_Customer")
Set ws = ThisWorkbook.ActiveSheet
cs_sht = ws.Name
' ERROR RUNNING THIS LINE vvvvv
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0)) = ws.Range("C_Firstname").Value
End Sub
Excel functions need to be nested, because a cell's value needs to be parsed as a single step.
VBA code doesn't need to do that. VBA instructions work best and are easier to debug when you split them and make them do as little work as possible.
So instead of this:
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0))
Split it up:
Dim matchResult As Long
matchResult = WorksheetFunction.Match(cs_sht, rng.ListColumns("Customer ID").DataBodyRange, 0)
Dim indexResult As Variant
indexResult = WorksheetFunction.Index(rng.ListColumns("FirstName").DataBodyRange, matchResult)
Note that you'll get a run-time error if either function fails to find what it's looking for. Use On Error to handle that case:
On Error GoTo CleanFail
Dim matchResult As Long
matchResult = WorksheetFunction.Match(...)
...
Exit Sub
CleanFail:
MsgBox "Could not find record for '" & cs_sht & "'." & vbNewLine & Err.Description
End Sub
Get rid of wf. There's no use to copy object references of objects that are already global. The fewer global variables you use, the better.
if the first name changes I can update the table to match the new name from my worksheet
You can't just assign the indexResult to a new value. The indexResult isn't holding a reference to any cell, it's just the result of the INDEX worksheet function. You need to use that result to get the cell you want to modify:
Dim targetCell As Range
Set targetCell = rng.ListColumns("FirstName").DataBodyRange.Cells(indexResult)
targetCell.Value = ws.Range("C_Firstname").Value

VBA to SAP // RFC function module with table as Input Parameter

I want to send data from Excel via a RFC-Connector to SAP.
For the RFC function module, I must fill a table as an input parameter. Comparable to the RFC function module STFC_DEEP_TABLE.
My VBA code stops at the with statement with the error:
“Object variable or With block variable not set”.
Sub RFC_DEEP_TABLE()
Dim sapConn As Object
Set sapConn = CreateObject("SAP.Functions")
If sapConn.Connection.Logon(0, False) <> True Then
MsgBox "Cannot Log on to SAP"
End If
Dim objRfcFunc As Object
Set objRfcFunc = sapConn.Add("STFC_DEEP_TABLE")
With objRfcFunc
.Exports.Item("IMPORT_TAB").value("STR") = "X" 'Objectvariable oder With-Blockvariable nicht festgelegt
End With
If objRfcFunc.Call = False Then
MsgBox objRfcFunc.Exception
End If
End Sub
I can't test this, but from reading up on VBA/SAP Net Connector, it looks like you, similar to the .Net Connector syntax for C#, have to add a row to an import table before setting field values.
Sub RFC_DEEP_TABLE()
Dim sapConn As Object
Set sapConn = CreateObject("SAP.Functions")
If sapConn.Connection.Logon(0, False) <> True Then
MsgBox "Cannot Log on to SAP"
End If
Dim objRfcFunc As Object
Set objRfcFunc = sapConn.Add("STFC_DEEP_TABLE")
Set import_tab = objRfcFunc.Tables("IMPORT_TAB")
import_tab.freetable
import_tab.appendrow
import_tab.cell("STR", 1) = "X"
If objRfcFunc.Call = False Then
MsgBox objRfcFunc.Exception
End If
End Sub
I'm not completely sure about the line assigning the value, the parameters of the cell method should be right, but I only found a couple of slightly contradictory blog and forum posts and I'm not absolutely sure the order of the parameters is correct.
I had the same problem, that I could not instantiate the BAPI. The SAP guys altered the BAPI, and I could access it without altering the code.
BTW:
the parameter order is:
import_tab.cell(line#, fieldname) = "X"

Strange error during addition of slicer cache

I'm developing an application with multiple pivot tables and slicers.
I try to prepare a template sheet and copy - paste it in order to create multiple analysis.
When I duplicate the sheet, the Slicers will be linked to both original and new pivot tables (belonging to the same SlicerCache), so I need to:
Unlink original SlicerCache from the new pivot table
Delete original Slicer from the new sheet
create new SlicerCache with the same connection settings
create new Slicer on the new sheet, belonging to the new SlicerCache
My code so far:
Function DuplicateSlicer(PreviousSlicer As Slicer) As Slicer
Dim NewSlC As SlicerCache
Dim NewSlicer As Slicer
Dim DestWorkSheet As Worksheet
Dim SlCSequence As Integer
Dim NewSlCName As String
With PreviousSlicer
Set DestWorkSheet = .Parent
.SlicerCache.PivotTables.RemovePivotTable (DestWorkSheet.PivotTables(1))
SlCSequence = 1
Do Until GetSlicerCache(DestWorkSheet.Parent, .SlicerCache.Name & SlCSequence) Is Nothing
SlCSequence = SlCSequence + 1
Loop
NewSlCName = .SlicerCache.Name & SlCSequence
Set NewSlC = DestWorkSheet.Parent.SlicerCaches.Add2(DestWorkSheet.PivotTables(1), _
.SlicerCache.SourceName, .SlicerCache.Name & SlCSequence)
Set NewSlicer = NewSlC.Slicers.Add(DestWorkSheet, Caption:=.SlicerCache.SourceName, _
Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height)
NewSlicer.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
.Delete
End With
End Function
My problem is with the line
DestWorkSheet.Parent.SlicerCaches.Add2(DestWorkSheet.PivotTables(1), _
.SlicerCache.SourceName, .SlicerCache.Name & SlCSequence)
According to MSDN help it should work even without specifying name:
The name Excel uses to reference the slicer cache (the value of the
SlicerCache.Name property). If omitted, Excel will generate a name. By
default, Excel concatenates "Slicer_" with the value of the
PivotField.Caption property for slicers with non-OLAP data sources,
... (Replacing any spaces with "_".) If required to make the name
unique in the workbook namespace, Excel adds an integer to the end of
the generated name. If you specify a name that already exists in the
workbook namespace, the Add method will fail.
However even if I use my code as above, or I just omit 3rd parameter, I keep getting
error 1004: The slicer cache already exists.
To make things even more complicated, if I use a variable for name parameter of Slicercaches.Add (NewSlCName = .SlicerCache.Name & SlCSequence) I get different one:
error: 5 "Invalid procedure call or argument"
I really don't have any idea how to fix it.
Update
I've used SlicerCaches.Add2 as that's available from the object tips.
According to another article .Add is deprecated and shouldn't be used.
I've also tried .Add instead of .Add2, it gives the same error.
So far the only approach I could make to work is this:
Create two templates with the same layout and pivot tables, one of them with slicers and the other is without.
To create a new sheet: duplicate the template without slicers, then run below code for creating the slicers in the new sheet:
Sub DuplicateSlicers(NewWorkSheet As Worksheet, SourceWorkSheet As Worksheet)
Dim SlC As SlicerCache
Dim sl As Slicer
For Each SlC In SourceWorkSheet.Parent.SlicerCaches
For Each sl In SlC.Slicers
If (sl.Parent Is SourceWorkSheet) Then
Call DuplicateSlicer(sl, NewWorkSheet)
End If
Next sl
Next SlC
End Sub
Function DuplicateSlicer(PreviousSlicer As Slicer, NewSheet As Worksheet) As Slicer
Dim NewSlC As SlicerCache
Dim NewSlicer As Slicer
If PreviousSlicer Is Nothing Then
Set DuplicateSlicer = Nothing
Exit Function
End If
On Error GoTo ErrLabel
With PreviousSlicer
Set NewSlC = NewSheet.Parent.SlicerCaches.Add2(NewSheet.PivotTables(1), _
.SlicerCache.SourceName)
Set NewSlicer = NewSlC.Slicers.Add(NewSheet, Caption:=.Caption, Top:=.Top, Left:=.Left, _
Width:=.Width, Height:=.Height)
End With
NewSlicer.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
Set DuplicateSlicer = NewSlicer
Exit Function
ErrLabel:
Debug.Print PreviousSlicer.Caption & " - " & Err.Number & ": " & Err.Description
Err.Clear
End Function

Test if range exists in VBA

I have a dynamically defined named range in my excel ss that grabs data out of a table based on a start date and an end date like this
=OFFSET(Time!$A$1,IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),1,MATCH(Date_Range_End,AllDates)-IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),4)
But if the date range has no data in the table, the range doesn't exists (or something, idk). How can I write code in VBA to test if this range exists or not?
I have tried something like
If Not Range("DateRangeData") Is Nothing Then
but I get "Runtime error 1004, method 'Range' of object '_Global' failed."
Here is a function I knocked up to return whether a named range exists. It might help you out.
Function RangeExists(R As String) As Boolean
Dim Test As Range
On Error Resume Next
Set Test = ActiveSheet.Range(R)
RangeExists = Err.Number = 0
End Function
You can replicate the match in your VBA to count before using the range how many rows you would have, or you can use error handling:
On Error Resume Next
Debug.Print range("DateRangeData").Rows.Count
If Err = 1004 Then
MsgBox "Range Empty"
Exit Sub
Else
MsgBox "Range full"
End If
Err.Clear
On Error GoTo 0
This is another approach. It has the advantage to take the container and the name you want to test. That means you can test either Sheets Names or Workbook Names for example.
Like this:
If NamedRangeExists(ActiveSheet.Names, "Date") Then
...
Else
...
End If
or
If NamedRangeExists(ActiveWorkbook.Names, "Date") Then
...
Else
...
End If
Public Function NamedRangeExists(ByRef Container As Object, item As String) As Boolean
Dim obj As Object
Dim value As Variant
On Error GoTo NamedRangeExistsError:
value = Container(item)
If Not InStr(1, CStr(value), "#REF!") > 0 Then
NamedRangeExists = True
End If
Exit Function
Exit Function
NamedRangeExistsError:
NamedRangeExists = False
End Function
Depending on the application you're doing, it's good to consider using a Dictionary. They're especially useful when you wanna check whether something exists.
Take this example:
Dim dictNames as Scripting.Dictionary
Sub CheckRangeWithDictionary()
Dim nm As Name
'Initially, check whether names dictionary has already been created
If Not dictNames Is Nothing Then
'if so, dictNames is set to nothing
Set dictNames = Nothing
End If
'Set to new dictionary and set compare mode to text
Set dictNames = New Scripting.Dictionary
dictNames.CompareMode = TextCompare
'For each Named Range
For Each nm In ThisWorkbook.Names
'Check if it refers to an existing cell (bad references point to "#REF!" errors)
If Not (Strings.Right(nm.RefersTo, 5) = "#REF!") Then
'Only in that case, create a Dictionary entry
'The key will be the name of the range and the item will be the address, worksheet included
dictNames(nm.Name) = nm.RefersTo
End If
Next
'You now have a dictionary of valid named ranges that can be checked
End Sub
Within your main procedure, all you need to do is do an existence check before using the range
Sub CopyRange_MyRange()
CheckRangeWithDictionary
If dictNames.exists("MyRange") then
Sheets(1).Range("MyRange").Copy
end if
End Sub
While loading the dictionary may look a little longer, it's extremely fast to process and search. It also becomes much simpler to check whether any named range referring to a valid address exists, without using error handlers in this simple application.
Please note that when using names at sheet level rather than workbook level, it is necessary to use more elaborate keys to guarantee uniqueness. From the way the dictionary was created, if a key is repeated, the item value is overwritten. That can be avoided by using the same Exists method as a check in the key creation statement. If you need a good reference on how to use dictionaries, use this one.
Good luck!
This is an old post, but none of the rated answers has a dynamic solution to test if a name exists in a workbook or worksheet. This function below will accomplish that:
Function pg_Any_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
pg_Any_Name = True
Exit Function
End If
Next n
End Function
Worth noting that this would not have worked for this specific question because OP had a dynamic defined range. This question would have been more accurately titled Test if Name is a Valid Range because the name always existed as a formula, the issue was if it was a valid RANGE. To address this question with a solution that checks both workbook and sheets... this function would work:
Function PG_Range_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
On Error Resume Next
PG_Range_Name = n.RefersToRange.Columns.Count > 0
Exit Function
End If
Next n
End Function

Resources