How do I get the name of a table from a range variable? - vba

I dimmed the variable:
Dim mainTableRange As Range
Then gave it a value:
Set mainTableRange = Range("tLedgerData") ' tLedgerData is an Excel table.
Now I'm trying to get the name of the table (which is "tLedgerData") from the variable to reference columns in that table even if the table name changes.
I tried
mainTableRange.Name
and
mainTableRange.Name.Name
(See how do you get a range to return its name.) Both threw run-time error '1004': Application defined or object-defined error.
mainTableRange.Select selected all table data excluding the header and total rows.

I think you're having an X-Y problem here: solving problem X when the solution is for problem Y.
[...] to reference columns in that table even if the table name changes
Have the table / ListObject alone on its own dedicated worksheet, and give the sheet a CodeName. That way you can do this:
Dim tbl As ListObject
Set tbl = LedgerDataSheet.ListObjects(1)
And now you have the almighty power of the ListObject API to do whatever it is that you want to do. For example, retrieve the column names:
Dim i As Long
For i = 1 To tbl.ListColumns.Count
Debug.Print tbl.ListColumns(i).Name
Next
In other words, you don't need to care for the name of the table. What you want is to work with its ListObject. And since you never need to refer to it by name, the table's name is utterly irrelevant and the user can change it on a whim, your code won't even notice.

I believe an Excel table and named-range are two different things which is why the .name.name doesn't work. A table is a ListObject and once you set a range equal to a table you should be able to continue to call that range without an error.
Curious, what is the reason why your table might change unexpectedly?
I wrote out some lines of code to show a couple things. You can create tables and reuse the range variables after the table name changes. You can also set AlternativeText for the table with some identifying string and use that to locate a particular table if you suspect the table name may change.
Option Explicit
Public TestTable As Range
Sub CreateTable()
ActiveSheet.ListObjects.Add(xlSrcRange, [$A$1:$C$4], , xlYes).name = "Table1"
ActiveSheet.ListObjects("Table1").AlternativeText = "Table1"
End Sub
Sub SetTableRange()
Set TestTable = Range("Table1")
End Sub
Sub SelectTable()
TestTable.Select
End Sub
Sub RenameTable()
ActiveSheet.ListObjects("Table1").name = "Table2"
[A1].Select
End Sub
Sub SelectRenamedTable()
TestTable.Select
End Sub
Sub ClearSelection()
[A1].Select
End Sub
Sub FindTable1()
Dim obje As ListObject
For Each obje In ActiveSheet.ListObjects
If obje.AlternativeText = "Table1" Then
MsgBox "Found " & obje.AlternativeText & ". Its current name is: " & obje.name
End If
Next obje
End Sub
Sub ConvertTablesToRanges()
' I found this snippet in a forum post on mrexcel.com by pgc01 and modified
Dim rList As Range
On Error Resume Next
With ActiveSheet.ListObjects("Table1")
Set rList = .Range
.Unlist ' convert the table back to a range
End With
With ActiveSheet.ListObjects("Table2")
Set rList = .Range
.Unlist ' convert the table back to a range
End With
On Error GoTo 0
With rList
.Interior.ColorIndex = xlColorIndexNone
.Font.ColorIndex = xlColorIndexAutomatic
.Borders.LineStyle = xlLineStyleNone
End With
End Sub

Related

How to divide all values in a pivot table column by a constant

I would like to scale (divide, multiply) a pivot tables value by some constant that I add into the pivot tables sheet, like so:
The problem of automatically updating the pivot tables values as the values in the original data change I already solved with this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveWorkbook.Worksheets("Sheet4").PivotTables(1).PivotCache.Refresh
End Sub
I have tried simply doing it inside a worksheet_change() method, but this gives type mismatch error:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("C4:C5"), Range(Target.Address)) Is Nothing Then
Application.EnableEvents = False
'Target.Value = Target.Value * Range("B1").Value <-- gives error of type mismatch
MsgBox VarType(Target.Value)
MsgBox VarType(Range("B1").Value)
Application.EnableEvents = True
End If
End Sub
Here is one way. When the event WorkSheet_Change fires, check if your scaling value (in B1) has changed. If so, re-write the calculated field:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("B1"), Range(Target.Address)) Is Nothing Then
ActiveWorkbook.Worksheets("Sheet4").PivotTables(1).CalculatedFields("ScaledField"). _
StandardFormula = "=Kaina*" & Range("B1").Value
End If
End Sub
You'll need to create a calculated field called ScaledField (or give it your own name - just change the code too) and you might want to change the formula if you don't want to scale [Kaina], but something else.
PS. If the value isn't [Kaina], but [Kaina Sausis] then the formula would require single quotes to wrap the field name:
StandardFormula = "='Kaina Sausis'*" & Range("B1").Value
Manipulating the value of data fields directly in the pivot table is not possible (try to manually change a value or with VBA and you get an error message).
It's possible to overwrite values of row fields, but that's a bit strange (they will stay like this after and not update anymore unless you by coincidence entered a valid value).
For calculations you can add a calculated field. If the value is constant and the value doesn't need to be taken from a Range just add a calculated field manually (Analyze > Fields ... > Calculated Field...) and enter the constant value in the formula.
Unfortunately calculated fields cannot reference ranges so if you really have to use the value from a Range in the formula of the calculated field you can use this VBA code (it adds a calculated field or updates the formula if the field already exists, that would be of use if the value is not constant):
' You prolly have to call this only once as you are using a constant value.
' If not add to your worksheet change event
' Modify hardcoded values if needed
Sub createOrUpdateField()
Dim fldFormula As String
' Construct the formula to use
fldFormula = "= Kaina Sausis / " & ActiveSheet.Range("B1").Value2
addOrUpdateCalculatedField _
ActiveSheet.PivotTables(1), _
"Kaina Sausis Calc", fldFormula, "0.00"
End Sub
' In case you want to remove the calculated field use this
' Or use the interface (Analyze > Fields ... > Calculated Field...)
Sub deleteField()
pt.PivotFields("Kaina Sausis Calc").Delete
End Sub
' Add a calculated field to pivot table or update formula if it already exists.
' Args:
' pt (PivotTable): The pivot table object
' fldName (String): Name to use for the field
' fldFormula (String): Formula to use for calculation
' fldFormat (String): Number format to use
Sub addOrUpdateCalculatedField(pt As PivotTable, fldname As String, _
fldFormula As String, fldFormat As String)
Dim wks As Worksheet
Dim ptfld As PivotField
' Try to reference the field to check if it already exists
On Error Resume Next
Set ptfld = pt.PivotFields(fldname)
On Error GoTo 0
If ptfld Is Nothing Then
' Field doesn't exist, add it
Set ptfld = pt.CalculatedFields.Add(name:=fldname, formula:=fldFormula)
With ptfld
.Caption = fldname
.NumberFormat = fldFormat
.Orientation = xlDataField
.Function = xlSum
End With
Else
' Field already exists, change the formula only
ptfld.StandardFormula = fldFormula
End If
Set wks = Nothing
Set pt = Nothing
Set ptfld = Nothing
End Sub

Adjust Table Heading Color With Merged Cells

I have a large number of reports which have multiple tables that need to have their heading color adjusted. I'm running into an issue with tables who have vertically merged cells in the header though. Here's the code:
Sub Recolor_Table()
Dim Doc_Table As Table
For Each Doc_Table In ActiveDocument.Tables
If Doc_Table.Style Like "*Non-Results Table*" Then
'Since this will match "*Results Table*" as well, check it first
Doc_Table.Rows(1).Shading.BackgroundPatternColor = 12566463 'Grey
ElseIf Doc_Table.Style Like "*Results Table*" Then
Doc_Table.Rows(1).Shading.BackgroundPatternColor = 8406272 'Blue
End If
Next Doc_Table
End Sub
This fails with the following error message:
Run-time error '5991':
Cannot access individual rows in this collection because the table has vertically merged cells
I tried adjusting to a loop through each cell in the table, but found that tables in word do not have a .cells property, so a For each cell in table.cells style loop wouldn't work.
Is there any other way to do this? Possibly editing the table style directly?
The Table object doesn't have a Cells property, but the Table.Range object does, so:
For Each cel in Table.Range.Cells
should work:
Sub LoopCellsInTableWithMergedCells()
Dim tbl As word.Table
Dim cel As word.Cell
Set tbl = ActiveDocument.Tables(1)
For Each cel In tbl.Range.Cells
Debug.Print cel.rowIndex, cel.ColumnIndex
Next
End Sub

Can I create a Jump table in VBA for Excel?

I wrote a simple translator / parser to process an EDI (830) document using multiple Select Case statements to determine the code to be executed. I’m opening a file in binary mode and splitting the document into individual lines, then each line is split into the various elements where the first element of every line has a unique segment identifier.
My code works perfectly as written. However, Select Case requires checking every Case until a match is found or the Case Else is executed. I’ve sequenced the Case statements in such a manner that the segments that appear most frequently (as in the case of loops), are placed first to minimize the number of "checks before code is actually executed.
Rather than using multiple Select Cases, I would prefer to determine an index for the segment identifier and simply call the appropriate routine using that index. I’ve used jump tables in C and Assembler and anticipated similar functionality may be possible in VBA.
You can do jump tables in VBA by using the Application.Run method to call the appropriate routine by name. The following code demonstrates how it works:
Public Sub JumpTableDemo()
Dim avarIdentifiers() As Variant
avarIdentifiers = Array("Segment1", "Segment2")
Dim varIdentifier As Variant
For Each varIdentifier In avarIdentifiers
Run "Do_" & varIdentifier
Next varIdentifier
End Sub
Public Sub Do_Segment1()
Debug.Print "Segment1"
End Sub
Public Sub Do_Segment2()
Debug.Print "Segment2"
End Sub
You can do this in Excel VBA, following the example below:
The example assumes you have split your EDI document into two columns, one with the 'processing instruction' and one with the data that instruction will process.
The jump table is to the right i.e. a distinct list of the 'processing instructions' plus a name of a Sub-routine to run for each instruction.
The code is:
Option Explicit
Sub JumpTable()
Dim wsf As WorksheetFunction
Dim ws As Worksheet
Dim rngData As Range '<-- data from your file
Dim rngCell As Range '<-- current "instruction"
Dim rngJump As Range '<-- table of values and sub to run for value
Dim strJumpSub As String
Dim strJumpData As String
Set wsf = Application.WorksheetFunction '<-- just a coding shortcut
Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
Set rngData = ws.Range("A2:A17") '<-- change to your range
Set rngJump = ws.Range("E2:F4") '<-- change to your circumstances
For Each rngCell In rngData
strJumpSub = wsf.VLookup(rngCell.Value, rngJump, 2, False) '<-- lookup the sub
strJumpData = rngCell.Offset(0, 1).Value '<-- get the data
Application.Run strJumpSub, strJumpData '<-- call the sub with the data
Next rngCell
End Sub
Sub do_foo(strData As String)
Debug.Print strData
End Sub
Sub do_bar(strData As String)
Debug.Print strData
End Sub
Sub do_baz(strData As String)
Debug.Print strData
End Sub
Make sure that you have written a Sub for each entry in the jump table.

VBA macro to change filters in pivot table

I'm trying do automate a daily report and therefore I want to create two buttons which change the filters of three pivot tables. In detail the buttons shall change the day which is shown. The first filters on yesterday the second one is a reset button do clear all filters and show all days.
The "Resest"-Button is working but the "Yesterday"-Button not.
At the moment the macro looks like that:
Private Sub CommandButton2_Click()
MsgBox ActiveSheet.Range("B1")
With ActiveSheet.PivotTables("Detail_Digital").PivotFields("Tag").CurrentPage = _
ACtiveSheet.Range("B1").Value
End With
End Sub
I've also tried PivotFilters.Add _ , Type:=xlDateYesterday but that isn't working either.
Any suggestions?
Try the code below, it should work, unless your "Date" is formatted differently between the Pivot's data source and Range("B1").
Note: try to avoid using ActiveSheet, instead use referenced objects. In the case below, replace Worksheets("Sheet1") with your sheet's name.
Code
Option Explicit
Private Sub CommandButton2_Click()
Dim PvtTbl As PivotTable
Dim PvtItm As PivotItem
' set the Pivot Table
Set PvtTbl = Worksheets("Sheet1").PivotTables("Detail_Digital")
With PvtTbl
.PivotFields("Tag").ClearAllFilters ' <-- clear all filters to "Tag"
'Debug.Print Worksheets("Sheet1").Range("B1").Value
For Each PvtItm In .PivotFields("Tag").PivotItems
If PvtItm.Name = Worksheets("Sheet1").Range("B1").Value Then
PvtItm.Visible = True
Else
PvtItm.Visible = False
End If
Next PvtItm
End With
End Sub

User Choice and loops vba

I'm trying to establish the logic for creating a navigation menu for a budget tracking system: it has 12 sheets for each budget line with 12 monthly tables per sheet.
The navigation menu is based on two combo boxes, one listing the sheets, and the other the names of the months - when a user selects where to go, the sheet and first cell in the chosen table activate.
What I'm looking for is a more effective way to organize this than writing 144 distinct if-then conditions accounting for every possible listindex combination the user might choose. The Select Case approach also works, but it is equally voluminous in scope...
I have been investigating using loops for the purpose - e.g. ListIndex values can be defined in a loop, but I'm coming up short on ideas for the overarching concept.
Thank you in advance!
Here I set up a workbook with 12 worksheets one for each month. Each worksheet has 12 tables on it. When the user selects a worksheet from the dropdown (cboWorkSheets) the second drop down (cboTables) list is cleared and then all the table names from the selected worksheet is added to back to the list.
When a user selects a table name from cboTables the worksheet referenced by cboWorkSheets is searched for that table. The first cell in the table's databody range is then selected.
Option Explicit
Private Sub cboTables_Change()
Dim ws As Worksheet
Dim tbl As ListObject
Set ws = Worksheets(cboWorkSheets.Value)
Set tbl = ws.ListObjects(cboTables.Value)
ws.Activate
tbl.DataBodyRange.Cells(1, 1).Select
End Sub
Private Sub cboWorkSheets_Change()
Dim ws As Worksheet
Dim tbl As ListObject
Set ws = Worksheets(cboWorkSheets.Value)
cboTables.Clear
For Each tbl In ws.ListObjects
cboTables.AddItem tbl.Name
Next
End Sub
Private Sub UserForm_Initialize()
cboWorkSheets.List = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", "Sheet11", "Sheet12")
End Sub
Doing the sheet selection is pretty straightforward. Just create an array that will hold the sheet name that corresponds to the ListIndex. Something like this
Dim myArray(11) As String
myArray(0) = "a"
myArray(1) = "b"
myArray(2) = "c"
...
myArray(10) = "k"
myArray(11) = "l"
Worksheets(myArray(ComboBox1.ListIndex)).Activate
If the person selects the 5th ComboBox element, sheet "e" would be activated.
Selecting the table cell is a bit more problematic since it depends on where on the sheet the tables are located. If they are spaced equidistantly apart, you can use a simple math formula. That is, if the January table starts at E7, Feb at E27, Mar at e47, then it is a simple matter of using the listindex to calculate the starting row. Eg:
Worksheets(myArray(ComboBox1.ListIndex)).Cells(7 + ComboBox2.ListIndex * 20, "E").Select
Hope this helps. :)
As general interest, this is the functional version of the code for a proof of concept file I built around #Tim's example, given above. Here goes:
In Module1:
Sub ComboBox1_Change()
Dim sheets_array(0 To 2) As Variant
sheets_array(0) = "Sheet1"
sheets_array(1) = "Sheet2"
sheets_array(2) = "Sheet3"
With UserForm1.ComboBox1
.Clear
.List = sheets_array
.Style = fmStyleDropDownCombo
End With
Call ComboBox2_Change
UserForm1.Show
End Sub
Sub ComboBox2_Change()
Dim monthsarray(0 To 3) As Variant
monthsarray(0) = "April"
monthsarray(1) = "May"
monthsarray(2) = "June"
With UserForm1.ComboBox2
.Clear
.List = monthsarray
.Style = fmStyleDropDownCombo
End With
End Sub
In the UserForm1 code window:
Private Sub ComboBox1_Change()
With UserForm1.ComboBox1
Worksheets(.List(.ListIndex)).Activate
End With
End Sub
Private Sub ComboBox2_Change()
With Worksheets(UserForm1.ComboBox1.ListIndex)
.Select
.Cells(7 + UserForm1.ComboBox2.ListIndex * 20, "E").Select
End With
End Sub
#Thomas Inzina, your solution is considerably more elegant and I hope I can think about programming at your level at some point.