Excel 2010, VBA, and ListObjects routines that do not update when a table changes

So, having this structure (starting with A1 - show snippet> run):

table { border-color: #BBB; border-width: 0px 0px 1px 1px; border-style: dotted; } body { font: 12px Arial, Tahoma, Helvetica, FreeSans, sans-serif; color: #333; } td { border-color: #BBB; border-width: 1px 1px 0px 0px; border-style: dotted; padding: 3px; } 
 <table> <tbody> <tr> <th></th> <th>A</th> <th>B</th> <th>C</th> <th>D</th> </tr> <tr> <td>1</td> <td>Title 1</td> <td>Title 2</td> <td>Title 3</td> <td>Title 4</td> </tr> <tr> <td>2</td> <td>GH</td> <td>1</td> <td>434</td> <td>4</td> </tr> <tr> <td>3</td> <td>TH</td> <td>3</td> <td>435</td> <td>5</td> </tr> <tr> <td>4</td> <td>TH</td> <td>4</td> <td>4</td> <td>6</td> </tr> <tr> <td>5</td> <td>LH</td> <td>2</td> <td>0</td> <td>3</td> </tr> <tr> <td>6</td> <td>EH</td> <td>2</td> <td>5</td> <td>36</td> </tr> </tbody> </table> 

I wrote code to convert this range (A1: D6) to ListObject, added 4 new columns and subtotals:

 Function test() Dim objLO As ListObject Set objLO = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$D$6"), , xlYes) objLO.Name = "Recap" objLO.TableStyle = "TableStyleMedium2" objLO.ListColumns.Add (objLO.ListColumns.Count + 1) objLO.HeaderRowRange(objLO.ListColumns.Count) = "Tot1" objLO.ListColumns.Add (objLO.ListColumns.Count + 1) objLO.HeaderRowRange(objLO.ListColumns.Count) = "Tot2" objLO.ListColumns.Add (objLO.ListColumns.Count + 1) objLO.HeaderRowRange(objLO.ListColumns.Count) = "Tot3" objLO.ListColumns.Add (objLO.ListColumns.Count + 1) objLO.HeaderRowRange(objLO.ListColumns.Count) = "Tot4" objLO.ShowTotals = True objLO.ListColumns("Tot1").TotalsCalculation = xlTotalsCalculationSum objLO.ListColumns("Tot2").TotalsCalculation = xlTotalsCalculationSum objLO.ListColumns("Tot3").TotalsCalculation = xlTotalsCalculationSum objLO.ListColumns("Tot4").TotalsCalculation = xlTotalsCalculationSum End Function 

Now, if you go to any cell of the new columns and write some numbers, it is strange that TOTAL (subtotal) is not updated; but if you save the file and close it again, it will work and the totals will be updated. What am I missing?

I already tried moving ShowTotals after TotalCalculation, but the behavior remains the same.

If we now rebuild the sheet from scratch and add this code snippet for subtotals for columns b, c and d after applying the style in the previous code:

 objLO.ListColumns("b").TotalsCalculation = xlTotalsCalculationSum objLO.ListColumns("c").TotalsCalculation = xlTotalsCalculationSum objLO.ListColumns("d").TotalsCalculation = xlTotalsCalculationSum 

I noticed that subtotals for b, c and d work, but not for Tot1, Tot2, etc.

It seems that the only workaround is to create the source table before adding a ListObject with links to its creation. Does anyone know a better solution?

Thank you in advance:)

+6
source share
2 answers

There is an outstanding error in Excel spreadsheets, and there are some subtleties that need to be solved in order to get the desired result.

A good fix using explicit calculation tricks works, but while this approach will update the totals based on the current values ​​in the data rows, they need to be applied every time the values ​​in the data table change.

There are two ways to get Excel to calculate the totals:

  • You can switch the calculation state of the parent sheet:

     objLO.Parent.EnableCalculation = False objLO.Parent.EnableCalculation = True 
  • Or you can replace = with totals formulas:

     objLO.TotalsRowRange.Replace "=", "=" 

But none of the above approaches give you a long-term solution that automatically updates the totals.

The best solution...

The key to the solution is that subtotals are dynamically calculated for the columns that existed when the ListObject was converted from a range to a ListObject.

You can use this knowledge and make sure that instead of adding columns to the end / right of the ListObject, you insert them in front of the existing column. But since you ultimately want the new columns to be right, this approach will require using a dummy column in the original range, then all new columns will be inserted before the Dummy column, and finally the Dummy columns can be removed.

See this modified code with comments:

 Function test() Dim objLO As ListObject 'Expand the selection to grab an additional Dummy column Set objLO = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E$6"), , xlYes) objLO.Name = "Recap" objLO.TableStyle = "TableStyleMedium2" 'Insert all of the new columns BEFORE the Dummy column objLO.ListColumns.Add (objLO.ListColumns.Count) objLO.HeaderRowRange(objLO.ListColumns.Count - 1) = "Tot1" objLO.ListColumns.Add (objLO.ListColumns.Count) objLO.HeaderRowRange(objLO.ListColumns.Count - 1) = "Tot2" objLO.ListColumns.Add (objLO.ListColumns.Count) objLO.HeaderRowRange(objLO.ListColumns.Count - 1) = "Tot3" objLO.ListColumns.Add (objLO.ListColumns.Count) objLO.HeaderRowRange(objLO.ListColumns.Count - 1) = "Tot4" 'Must show totals BEFORE applying totals, otherwise the last column defaults to Count (even if we override it) objLO.ShowTotals = True objLO.ListColumns("Tot1").TotalsCalculation = xlTotalsCalculationSum objLO.ListColumns("Tot2").TotalsCalculation = xlTotalsCalculationSum objLO.ListColumns("Tot3").TotalsCalculation = xlTotalsCalculationSum objLO.ListColumns("Tot4").TotalsCalculation = xlTotalsCalculationSum 'Remove the extra dummy column objLO.ListColumns(objLO.ListColumns.Count).Delete 'Now toggle the ShowTotals to force the ListObject to recognise the new column totals objLO.ShowTotals = False objLO.ShowTotals = True End Function 
+1
source

You are missing nothing. This issue seems to be a bug that Microsoft has not yet fixed.

The only thing you can try is to save / close / reopen the code book.

0
source

Source: https://habr.com/ru/post/983278/


All Articles