Run-time error 424 accessing a table

JenniferMurphy

Well-known Member
Joined
Jul 23, 2011
Messages
2,482
Office Version
  1. 365
Platform
  1. Windows
I found code examples online for accessing various parts of a table using the ListObjects object. I am doing something wrong. The Set TableData statement gets a run-time error 424.

VBA Code:
Sub WtdRtg()

Const rnTable As String = "Tbl"   'The name of the main table
Dim TblData
TblData = Range(rnTable).Value

Dim TableData As ListObject

'Run-time error 424
Set TableData = ActiveSheet.ListObjects(rnTable).Range.Select

Dim TableHdr As ListObject

Set TableHdr = ActiveSheet.ListObjects(rnTable).HeaderRowRange.Select

End Sub
 
Here's a more complete picture.

My code:

VBA Code:
Sub WtdRtg()

Const rnTable As String = "Tbl"   'The name of the main table
Dim rngTableData As Range
Set rngTableData = ActiveSheet.ListObjects(rnTable).Range

Dim rngPrices As Range
Set rngPrices = ActiveSheet.ListObjects(rnTable).ListColumns(3).DataBodyRange
Debug.Print "rngPrices = " & rngPrices(1, 1) & " " & rngPrices(2, 1) _
            & " " & rngPrices(3, 1) & " " & rngPrices(4, 1)
Dim PriceSumRng As Double
PriceSumRng = Application.WorksheetFunction.Sum(rngPrices)
Debug.Print "PriceSumRng = " & PriceSumRng

Debug.Print ""

Dim arrPrices As Variant
arrPrices = rngPrices.Value
Debug.Print "arrPrices = " & arrPrices(1, 1) & " " & arrPrices(2, 1) _
            & " " & arrPrices(3, 1) & " " & arrPrices(4, 1)
Dim PriceSumArr As Double
PriceSumArr = Application.WorksheetFunction.Sum(arrPrices)
Debug.Print "PriceSumArr = " & PriceSumArr

End Sub

Here's the immediate window:

Code:
rngPrices = 199.99 249.99 175 215
PriceSumRng = 839.98

arrPrices = 199.99 249.99 175 215
PriceSumArr = 0
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Love your work.
It doesn't happen at my end using your XL2BB but have discovered that XL2BB loses the number formatting.

Change the line below to be .Value2
Rich (BB code):
arrPrices = rngPrices.Value2

Your numbers are formatted as Currency and Value2 reads just the underlying number while Value reads Dates and Currency differently.
 
Last edited:
Upvote 0
Love your work.

Thanks, but you are the one with the beautiful work. You are one of several on this board who have saved me at least days of work and probably weeks. Without this board, Excel would be unusable for me for anything beyond simple tables.

It doesn't happen at my end using your XL2BB but have discovered that XL2BB loses the number formatting.

Change the line below to be .Value2
Rich (BB code):
arrPrices = rngPrices.Value2

Your numbers are formatted as Currency and Value2 reads just the underlying number while Value reads Dates and Currency differently.

That did it. The code now works perfectly.

Thank you very much! 👍👍👏👏🥰

I wondered what .Value2 was for, but was too lazy to look it up. I thonk I will now use it preffy much all the time except for when I might need the formatti g, whoich I cannot imagine when in VBA code.

I have made this the solution because it is more complete.

I do have one final question:

It is true that if I am going to do a lot of processing on a range of data that it is more efficient to load it into a VBA array that keep accessing it in the sheet via a range?
 
Upvote 0
is true that if I am going to do a lot of processing on a range of data that it is more efficient to load it into a VBA array that keep accessing it in the sheet via a range?

Definitely. It is significantly faster if you can minimise the number of individual reads and writes to the spreadsheet. Eventhough you are still reading all the cells and then writing all the cells, doing it as a single read into an array and single write back to the spreadsheet is much faster than doing individual reads and writes, not to mention that any looping and calculations are now in memory.

If you haven't done much with arrays, below is the syntax for writing an single column from your array back to the spreadsheet.

VBA Code:
Sub WriteBackSingleColumn()

    Dim arr As Variant
    Dim rng As Range
    Dim ArrColToWriteBack As Long
    
    arr = Range("A1").CurrentRegion     ' Test Data has 3 columns
    
    Set rng = Range("G1")
    ArrColToWriteBack = 2
    rng.Resize(UBound(arr), 1).Value2 = Application.Index(arr, 0, ArrColToWriteBack)  '    It will work without specifying the .Value2
    
End Sub
 
Upvote 0
Definitely. It is significantly faster if you can minimise the number of individual reads and writes to the spreadsheet. Eventhough you are still reading all the cells and then writing all the cells, doing it as a single read into an array and single write back to the spreadsheet is much faster than doing individual reads and writes, not to mention that any looping and calculations are now in memory.
That's what I thought. Thanks.

If you haven't done much with arrays, below is the syntax for writing an single column from your array back to the spreadsheet.
VBA Code:
Sub WriteBackSingleColumn()

    Dim arr As Variant
    Dim rng As Range
    Dim ArrColToWriteBack As Long
   
    arr = Range("A1").CurrentRegion     ' Test Data has 3 columns
   
    Set rng = Range("G1")
    ArrColToWriteBack = 2
    rng.Resize(UBound(arr), 1).Value2 = Application.Index(arr, 0, ArrColToWriteBack)  '    It will work without specifying the .Value2
   
End Sub
You are one jump ahead of me -- probably not a difficult task. 🤔😥 That is the next thing I was going to need to do. Thanks!
 
Upvote 0
If you haven't done much with arrays, below is the syntax for writing an single column from your array back to the spreadsheet.

I will be writing back column 2 of the body of the table. I couldn't follow your code example, so I fiddled around and came up with this, which works. The last 4 statements write those test values to column 2 of the table. Let me know if you have any corrections.
Code:
Sub WtdRtg()
Const MyName As String = "WtdRtg"   'The name of this macro for error messages

' Some constants
Const MinRows As Long = 1   'Table must have at least 1 row
Const MinCols As Long = 3   'Table must have at least 3 columns (name, wtdrtg, attribute)

' Get the name of the table
Const rnTableName As String = "TableName" 'The name of the cell with the name of the table
Dim rnTable As String                     'The name of the table
rnTable = Range(rnTableName).Value2       '.Load the table name

' Load the headers into one array and the body into another
Dim TableHdr As Variant       'The table header row
TableHdr = ActiveSheet.ListObjects(rnTable).HeaderRowRange.Value2
Dim TableData As Variant      'The table data (body)
TableData = ActiveSheet.ListObjects(rnTable).DataBodyRange.Value2

'Do some validity checking
Dim TblRows As Long: TblRows = UBound(TableData, 1) 'Get the number of rows
If TblRows < MinRows Then
  MsgBox "Table has less than " & MinRows & " rows": Exit Sub: End If
Dim TblCols As Long: TblCols = UBound(TableData, 2) 'Get the number of columns
If TblCols < MinCols Then
  MsgBox "Table has less than " & MinCols & " columns": Exit Sub: End If

Dim rngTableData As Range
Set rngTableData = ActiveSheet.ListObjects(rnTable).DataBodyRange
rngTableData(1, 2).Value = 1  'Test data
rngTableData(2, 2).Value = 2  'Test data
rngTableData(3, 2).Value = 3  'Test data
rngTableData(4, 2).Value = 4  'Test data
 
Upvote 0
Assuming the code was meant to demonstrate the use of an array, doesn't really do that at all.

The data is being written using direct sheet access and not an array. I deleted these lines which are the write lines:
VBA Code:
'Dim rngTableData As Range
'Set rngTableData = ActiveSheet.ListObjects(rnTable).DataBodyRange
'rngTableData(1, 2).Value = 1  'Test data
'rngTableData(2, 2).Value = 2  'Test data
'rngTableData(3, 2).Value = 3  'Test data
'rngTableData(4, 2).Value = 4  'Test data

Personal preference but I Set loTable = Range(rnTable).ListObject rather than continually referencing ActiveSheet.ListObject.
Also personal preference, I added an arr prefix to your 2 array names to help me follow the code.

I updated column 2 of your array using a loop using the same test data 1 to 4.
Then wrote out the array back to Column 2 of the table.

Rich (BB code):
Sub WtdRtg_Array()
Const MyName As String = "WtdRtg"   'The name of this macro for error messages

' Some constants
Const MinRows As Long = 1   'Table must have at least 1 row
Const MinCols As Long = 3   'Table must have at least 3 columns (name, wtdrtg, attribute)

' Get the name of the table
Const rnTableName As String = "TableName" 'The name of the cell with the name of the table
Dim rnTable As String                     'The name of the table
rnTable = Range(rnTableName).Value2       '.Load the table name

' XXX Set the ListObject variable and replace ActiveSheet.ListObject in the rest of the code
Dim loTable As ListObject
Set loTable = Range(rnTable).ListObject

' Load the headers into one array and the body into another
Dim arrTableHdr As Variant       'The table header row
arrTableHdr = loTable.HeaderRowRange.Value2
Dim arrTableData As Variant      'The table data (body)
arrTableData = loTable.DataBodyRange.Value2

'Do some validity checking
Dim TblRows As Long: TblRows = UBound(arrTableData, 1) 'Get the number of rows
If TblRows < MinRows Then
  MsgBox "Table has less than " & MinRows & " rows": Exit Sub: End If
Dim TblCols As Long: TblCols = UBound(arrTableData, 2) 'Get the number of columns
If TblCols < MinCols Then
  MsgBox "Table has less than " & MinCols & " columns": Exit Sub: End If

' Test data
' Load test data (sequential no) into array)
Dim i As Long
For i = 1 To UBound(arrTableData, 1)
    arrTableData(i, 2) = i
Next i

' Writing out just Column 2 of the array
loTable.ListColumns(arrTableHdr(1, 2)).DataBodyRange.Resize(UBound(arrTableData, 1)) = Application.Index(arrTableData, 0, 2)

' Alternative - Comment out previous line and uncomment line below
' Writing out the whole array (all columns)
' loTable.DataBodyRange.Resize(UBound(arrTableData, 1), UBound(arrTableData, 2)) = arrTableData

End Sub
 
Upvote 0
Solution
Assuming the code was meant to demonstrate the use of an array, doesn't really do that at all.

The data is being written using direct sheet access and not an array. I deleted these lines which are the write lines:
VBA Code:
'Dim rngTableData As Range
'Set rngTableData = ActiveSheet.ListObjects(rnTable).DataBodyRange
'rngTableData(1, 2).Value = 1  'Test data
'rngTableData(2, 2).Value = 2  'Test data
'rngTableData(3, 2).Value = 3  'Test data
'rngTableData(4, 2).Value = 4  'Test data
😄🤔😂 It was only meant to show that I was able to get the data into an array. I knew that the 4 lines above were making 4 separate puts back into the sheet. They were just a quick and dirty way to show that the data would actually get written out to the right cells. My plan was to replace them with something like what you showed. But I would never have come up with anything as elegant as what you posted. For that, I cannot thank you enough. I wish I could buy you a beer or dinner or something. I have learned more from this thread than anything I can recall from the last 10 years.

Thank you, thank you, thank you.

PS: I have adopted all of your other suggestions.

PPS: This is a such a valuable post, that I am going to make it the solution. I hope that is not too confusing for other readers.
 
Upvote 0
Assuming the code was meant to demonstrate the use of an array, doesn't really do that at all.
. . .
Ok. I now have a working macro. I think I did it right.

Code:
Sub WtdRtg()
Const MyName As String = "WtdRtg"   'The name of this macro for error messages

' Some constants
Const MinRows As Long = 1   'Table must have at least 1 row
Const MinCols As Long = 3   'Table must have at least 3 columns (name, wtdrtg, 1 attribute)
Const WRCol As Long = 2     'The weighted rating column

' Worker variables
Dim iCol As Long    'Loop index
Dim iRow As Long    'Loop index

' Get the name of the table
Const rnTableName As String = "TableName" 'The name of the cell with the name of the table
Dim rnTable As String                     'The name of the table
rnTable = Range(rnTableName).Value2       '.Load the table name

' Define a ListObject variable. It will replace ActiveSheet.ListObject in the rest of the code
Dim loTable As ListObject
Set loTable = Range(rnTable).ListObject

' Load the headers into one array and the body into another
Dim arrTableHdr As Variant       'The table header row
arrTableHdr = loTable.HeaderRowRange.Value2
Dim arrTableData As Variant      'The table data (body)
arrTableData = loTable.DataBodyRange.Value2

'Do some validity checking
Dim NumRows As Long: NumRows = UBound(arrTableData, 1) 'Get the number of rows
If NumRows < MinRows Then
  MsgBox "Table has less than " & MinRows & " rows": Exit Sub: End If
Dim NumCols As Long: NumCols = UBound(arrTableData, 2) 'Get the number of columns
If NumCols < MinCols Then
  MsgBox "Table has less than " & MinCols & " columns": Exit Sub: End If

'Calculate the means and std deviations (just the data columns)
Dim arrMeans() As Double:     ReDim arrMeans(NumCols)   'The means for each data column
Dim arrStdDevs() As Double:   ReDim arrStdDevs(NumCols) 'The std devs for each data column
Dim arrNextCol() As Variant:  ReDim arrNextCol(NumRows) 'The property data in the next column
For iRow = 1 To NumRows         'Zero the WtdRtgs
  arrTableData(iRow, WRCol) = 0
Next iRow
For iCol = MinCols To NumCols
  With Application.WorksheetFunction
    arrNextCol = .Index(arrTableData, 0, iCol)
    arrMeans(iCol) = .Average(arrNextCol)
    arrStdDevs(iCol) = .StDev_S(arrNextCol)
  End With
  For iRow = 1 To NumRows
    arrTableData(iRow, WRCol) = arrTableData(iRow, WRCol) + _
      ((arrTableData(iRow, iCol) - arrMeans(iCol)) / arrStdDevs(iCol))
  Next iRow
Next iCol

' Write out just weighted ratings column (2) of the array
loTable.ListColumns(arrTableHdr(1, WRCol)).DataBodyRange.Resize(UBound(arrTableData, 1)) _
       = Application.Index(arrTableData, 0, WRCol)

End Sub
It operates on this sheet table. I have not yet implemented the Order or Weight rows (7 & 8).

Weighted Ratings.xlsm
BCDEFG
2TblMainTable name
3
4Mean$209.9954.525001386.5062.2500
5Std Dev$31.3550.095742125.2617.5381
6
7OrderHiLoHiLoHiLoHiLo
8Weights1111
9ProductWtdRtgPriceARtgARevsWeight
10A+0.15847$199.994.54,56249 lbs
11B+1.59861$249.994.67565 lbs
12C-1.55854$175.004.638749 lbs
13D-0.19853$215.004.452286 lbs
14Means$210.004.51,38762 lbs
15
16ProductWtdRtgPriceARtgARevsWeight
17A+0.15847-0.31909-0.26112+1.49417-0.75550
18B+1.59860+1.27555+0.78335-0.61710+0.15680
19C-1.55854-1.11609+0.78335-0.47030-0.75550
20D-0.19853+0.15962-1.30558-0.40677+1.35420
21Z Sum=0.00000-0.00000=0.00000=0.00000
WtdRtg
Cell Formulas
RangeFormula
D4D4=AVERAGE(TblMain[Price])
E4E4=AVERAGE(TblMain[ARtg])
F4F4=AVERAGE(TblMain[ARevs])
G4G4=AVERAGE(TblMain[Weight])
D5D5=STDEV.S(TblMain[Price])
E5E5=STDEV.S(TblMain[ARtg])
F5F5=STDEV.S(TblMain[ARevs])
G5G5=STDEV.S(TblMain[Weight])
D14D14=SUBTOTAL(101,[Price])
E14E14=SUBTOTAL(101,[ARtg])
F14F14=SUBTOTAL(101,[ARevs])
G14G14=SUBTOTAL(101,[Weight])
D17:G20D17=ZScore(D10,D$4,D$5,D$7)
D21:G21D21=SUM(D17:D20)
C17:C20C17=SUMPRODUCT(D17:G17,D$8:G$8)
 
Upvote 0
Re: Your feedback post.
Wow that a big call 😉 but thank you, I really appreciate the sentiment. 😊

Ok. I now have a working macro. I think I did it right.
Hopefully I can leave it up to you to validate the output but your use of arrays looks fine to me.
 
Upvote 0

Forum statistics

Threads
1,213,496
Messages
6,113,995
Members
448,539
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top