Formula To Reference Changing name of Table

[bjbenny1]

I am trying to run a quick format on a table that includes adding a Vlookup formula. The formula references a table that comes out of a pivot table, so it has a different name every time. If I look up the new generated table name, and change it below it works. Is there a way to capture the table name and insert it into the formula? Or possibly rename the table to the same thing everytime (which I think is going to cause some conflict).

Thank you

code:

Sub complete()
'
' complete Macro
'
' Keyboard Shortcut: Ctrl+a
'
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("I:N").Select
Selection.Delete Shift:=xlToLeft
Columns("K:M").Select
Selection.Delete Shift:=xlToLeft
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(Table16)[[#This Row],[SecurityID]], PTR!C[-2]:C, 3, FALSE), 0)"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=Table13[[#This Row],[Column1]]/SUM(C[-6])"
Columns("M:M").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
End Sub

 

[DonkeyOte]

I'm not really sure how trivial this is - I'm "guessing" that the Table is created as a result of drilling down into a cell within the PT DataBody, correct ?

If so I wonder if perhaps you could use something as convoluted as:

Dim boolDrill As Boolean

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If boolDrill Then
    Application.ExecuteExcel4Macro "SET.NAME(""strTbl"",""" & Sh.ListObjects(1).Name & """)"
    boolDrill = False
    Call Example
End If
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim PT As PivotTable
For Each PT In Sh.PivotTables
    If Not Intersect(Target, PT.DataBodyRange) Is Nothing Then boolDrill = True
Next PT
End Sub

the above would reside in ThisWorkbook in VBEditor.

Your other code, stored in a normal module, could then access the name of the last table created by virtue of PT drill down using

Application.ExecuteExcel4Macro("strTbl")

EDIT:

having now just re-read your code - it would appear that you're applying the code to the newly created sheet - in which case you can determine the table name simply using:

ActiveSheet.ListObjects(1).Name

Also perhaps worth pointing out that:

Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("I:N").Select
Selection.Delete Shift:=xlToLeft
Columns("K:M").Select
Selection.Delete Shift:=xlToLeft

can be replaced with:

Range("A:B,G:G,K:K,M:R,U:W").Delete Shift:=xlToLeft

selecting objects is rarely required - will slow the sub routine.

 

[bjbenny1]

Thank you for the reply. I am pretty new at this. Your assumptions are all correct. I am working on a table generated from double clicking on a PT. I had a couple of problems making your code work.

I got Delete method of range class failed when using code:
Sub Quickie()
'
' format Macro
'
' Keyboard Shortcut: Ctrl+w
'
Range("A:B,G:G,K:K,M:R,U:W").Delete Shift:=xlToLeft
Columns("A:K").Select
Selection.Copy
End Sub

With the inefficient long version I still get Application-defined or object defined error with:Sub complete()
'
' complete Macro
'
' Keyboard Shortcut: Ctrl+a
'
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("I:N").Select
Selection.Delete Shift:=xlToLeft
Columns("K:M").Select
Selection.Delete Shift:=xlToLeft
Columns("A:K").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(ActiveSheet.ListObjects(1).Name)[[#This Row],[SecurityID]], PTR!C[-2]:C, 3, FALSE), 0)"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=ActiveSheet.ListObjects(1).Name[[#This Row],[Column1]]/SUM(C[-6])"
Columns("M:M").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
End Sub


Any assistance would be greatly appreciated. I didn't get the initial code in b/c your assumptions were all correct. Thank you again.

BJ

 

[DonkeyOte]

could you

a) outline the layout of your table once you have removed the unwanted columns

b) outline where exactly you're looking to add the formulae (ie which column)

My delete code won't work on a Table object given you can only remove contiguous ranges, eg:

Sub Quickie()
Dim rngArea As Range, lngArea As Long, strTable As String
Application.ScreenUpdating = True
On Error Resume Next
strTable = ActiveSheet.ListObjects(1).Name
On Error GoTo 0
If strTable = "" Then GoTo ExitPoint
Set rngArea = Range("A:B,G:G,K:K,M:R,U:W")
For lngArea = rngArea.Areas.Count To 1 Step -1
    rngArea.Areas(lngArea).Delete
Next lngArea
ExitPoint:
Application.ScreenUpdating = True
End Sub

but the above is still missing the important bits...


on a final note - going forward - please encase your VBA within CODE tags else it can be hard to read through... to do this you can highlight your VBA and press the # icon - if you're unable to see the icon click "Go Advanced"
(note you won't be able to edit your old posts)

 

[bjbenny1]

Your code worked to remove the unwanted columns. I could certainly add the formula after in a different macro. I want to add two formula fields that both need to use Vlookup functions on a static worksheet (PTR). These would be in column L and then in Column N. I would prefer if they stayed part of the table to make sorting easy once complete I want to remove all rows that have a 0 in column L. Thank you for the insert code lesson. Is there any past code that I can re-post correctly to help?

 

[DonkeyOte]

These would be in column L and then in Column N.

OK, so going back to the earlier questions - what are the final dimensions of the table once the delete has been executed ?

ie does the table end at column K (such that new columns are to right of current table) or are you looking to insert new columns into the table (ie shift existing column L to M so as to insert new L etc...?)

 

[bjbenny1]

Final Dimensions of table are A:K once delete is complete. I am trying to insert columns to table in L and M that are formulas. If it works better, I would insert the columns between column C and D.

 

[DonkeyOte]

I confess I don't work with Tables / Lists much so there are undoubtedly better methods and though I can't follow your formulae - in basic terms perhaps something along the lines of:

Sub Quickie()
Dim rngArea As Range
Dim strTable As String, strFormula As String
Dim lngArea As Long, lngCols As Long
Dim bCol As Byte
Application.ScreenUpdating = True
On Error Resume Next
strTable = ActiveSheet.ListObjects(1).Name
On Error GoTo 0
If strTable = "" Then GoTo ExitPoint
Set rngArea = Range("A:B,G:G,K:K,M:R,U:W")
For lngArea = rngArea.Areas.Count To 1 Step -1
    rngArea.Areas(lngArea).Delete
Next lngArea
With ActiveSheet.ListObjects(1)
    lngCols = .ListColumns.Count
    For bCol = 1 To 2
        .ListColumns.Add
        If bCol = 1 Then
            strFormula = "=" & strTable & "[[#This Row],[Column6]]"
        Else
            strFormula = "=" & strTable & "[[#This Row],[Column3]]"
        End If
        Cells(2, lngCols + bCol).FormulaR1C1 = strFormula
    Next bCol
End With
ExitPoint:
Application.ScreenUpdating = True
End Sub

(where Column6 and Column3 are column names within the Table)

Obviously you need to modify the formulae per your own requirements & setup

 

[bjbenny1]

Here is what I put in for Draft

Sub Quickie()
Dim rngArea As Range, lngArea As Long, strTable As String
Application.ScreenUpdating = True
On Error Resume Next
strTable = ActiveSheet.ListObjects(1).Name
On Error GoTo 0
If strTable = "" Then GoTo ExitPoint
Set rngArea = Range("A:B,G:G,K:K,M:R,U:W")
For lngArea = rngArea.Areas.Count To 1 Step -1
    rngArea.Areas(lngArea).Delete
Next lngArea
With ActiveSheet.ListObjects(1)
    lngCols = .ListColumns.Count
    For bCol = 1 To 2
        .ListColumns.Add
        If bCol = 1 Then
            strFormula = "=" & "IFERROR" & "VLOOKUP" & strTable & "[[#This Row],[SecurityID]],PTR!J:L,3,FALSE), 0)"
        Else
            strFormula = "=" & strTable & "[[#This Row],[Column1]]/(SUM(G:G))"

   End If
        Cells(2, lngCols + bCol).FormulaR1C1 = strFormula
    Next bCol
End With
 


ExitPoint:
Application.ScreenUpdating = True
End Sub

It appears to add one column to the end of the table and then I get an error. I think the formulas look good, but it I get an error after the End IF

 

[bjbenny1]

Sorry,

Changed

If bCol = 1 Then
            strFormula = "=" & "IFERROR(Vlookup" & strTable & "[[#This Row],[SecurityID]],PTR!J:L,3,FALSE), 0)"
        Else
            strFormula = "=" & strTable & "[[#This Row],[Column1]]/(SUM(G:G))"

   End If
        Cells(2, lngCols + bCol).FormulaR1C1 = strFormula

Still same error