Excel VBA Run-Time Error

D

Dave_P_C

New Member
Joined
Nov 9, 2006
Messages
37
Hello all,

Hoping to get some advice please as I'm struggling to get the following line of code working on the WeeklyChange worksheet containing a table called WklyChange as it always results in :-

Run-time error '1004':
Application-defined or object-defined error

VBA Code: 
tbl.ListColumns(tbl.ListColumns.Count - 1).DataBodyRange.FormulaR1C1 = "=[@[" & todaysDate & "]]-[@[" & oldDateColumnHeader & "]]"

The WklyChange table on the WeeklyChange worksheet has a similar structure to below.

Title15/03/2023Weekly Change20/03/2023
Name 1868-160708
Name 2859-160699
Name 3843-160683
Name 4777-68709
Name 5333100444

The stripped down code that will result in the error is below: -

VBA Code: 
Sub MySubroutine()
    Dim newTblName As String
    Dim todaysDate As String
    Dim oldDateColumnHeader As String
    
    todaysDate = Format(Date, "dd-mm-yy")
    
    ' Get a reference to the table
    Set tbl = ActiveSheet.ListObjects("WklyChange")
    
    newTblName = "Table11"
    todaysDate = Format(Date, "dd-mm-yy")
    ' Get the Old Date Column header
    oldDateColumnHeader = tbl.ListColumns(tbl.ListColumns.Count - 2).Range.Cells(1, 1).Value
    MsgBox ("oldDateColumnHeader = " & oldDateColumnHeader)
    
    ' Update the formulas in the second to last column
    MsgBox ("todaysDate = " & todaysDate & " - oldDateColumnHeader = " & oldDateColumnHeader)
    tbl.ListColumns(tbl.ListColumns.Count - 1).DataBodyRange.Select
    tbl.ListColumns(tbl.ListColumns.Count - 1).DataBodyRange.FormulaR1C1 = "=[@[" & todaysDate & "]]-[@[" & oldDateColumnHeader & "]]"

End Sub

I thought I had this working previously so not sure why it is not working.


Thanks for taking a look.

Dave.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
Your actual headers appear to use 4 digit years but your code is formatting as yy rather than yyyy
 
Upvote 0
Thanks @RoryA - typo regards the date formats - corrected but I still have an issue :(

The following code now works

Excel Formula: 
Tbl.ListColumns(Tbl.ListColumns.Count - 1).DataBodyRange.FormulaR1C1 = "=[@[" & todaysDate & "]]-[@[" & oldDateColumnHeader & "]]"

but the following code still results in a runtime error

Excel Formula: 
Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.FormulaR1C1 = "=IF($A$3<>"""",COUNTIFS(" & newTblName & "[[#All],[Service Name]],$A$3," & newTblName & "[[#All],[Title]],[@Title]),COUNTIF(" & newTblName & "[[#All],[Title]],[@Title]))"

I have put the formula into a message box and the output looks correct but I can not get the formula to be accepted.

I have typed in the formula substituting " & newTblName & " for the active Table name I.e. Table11 and it works.

Too late now - will need to take another look tomorrow but any guidance happily received.
 
Upvote 0
Hi - I am still struggling to get the final line of code working to update the values in the last column of the table. I've tried all these variations but keep getting a run-time error.

If I enter the code as an Excel formula in the final column cells it works without issue but I cannot get the VBA code to work.

Can anyone explain to me why the formula from VBA code will not work and what do I need to do to fix it?

Excel Formula: 
=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],$A6),COUNTIF(Table12[[#All],[Title]],$A6))

VBA Code: 
Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],$A6),COUNTIF(Table12[[#All],[Title]],$A6))"

VBA Code: 
Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],[@Title]),COUNTIF(Table12[[#All],[Title]],[@Title]))"

VBA Code: 
Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(" & newTblName & "[[#All],[Service Name]],$A$3," & newTblName & "[[#All],[Title]],$A6),COUNTIF(" & newTblName & "[[#All],[Title]],$A6)"

VBA Code: 
lastCol.DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],$A6),COUNTIF(Table12[[#All],[Title]],$A6))"

VBA Code: 
lastCol.DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],[@Title]),COUNTIF(Table12[[#All],[Title]],[@Title]))"

VBA Code: 
lastCol.DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(" & newTblName & "[[#All],[Service Name]],$A$3," & newTblName & "[[#All],[Title]],$A6),COUNTIF(" & newTblName & "[[#All],[Title]],$A6)"

The

First Tab Called 14-03-23 with the data in a Table called Table11
MySubRoutine.xlsm
AB
1Service NameTitle
2Service1Title1
3Service2Title2
4Service3Title9
5Service4Title4
6Service5Title5
14-03-23


Second Tab Called 21-03-23 with the data in a Table called Table12
MySubRoutine.xlsm
AB
1Service NameTitle
2Service1Title1
3Service2Title2
4Service3Title1
5Service4Title4
6Service5Title5
7Service1Title6
8Service2Title7
9Service3Title8
10Service4Title9
11Service5Title10
21-03-23


Third Tab Called Weekly Change with rows 5 to 15 columns A to E with data in a Table called WklyChange
MySubRoutine.xlsm
ABCDE
5TitleWeekly Change1019/03/2023Weekly Change1120/03/2023
6Title11112
7Title20101
8Title31000
9Title42101
10Title54101
11Title60011
12Title73011
13Title81011
14Title91101
15Title109011
Weekly Change
Cell Formulas
RangeFormula
C6:C15C6=IF($A$3<>"",COUNTIFS('14-03-23'!$A$1:$A$6,$A$3,'14-03-23'!$B$1:$B$6,'Weekly Change'!$A6),COUNTIF('14-03-23'!$B$1:$B$6,'Weekly Change'!$A6))
D6:D15D6='Weekly Change'!$E6-'Weekly Change'!$C6
E6:E15E6=IF($A$3<>"",COUNTIFS('21-03-23'!$A$1:$A$11,$A$3,'21-03-23'!$B$1:$B$11,'Weekly Change'!$A6),COUNTIF('21-03-23'!$B$1:$B$11,'Weekly Change'!$A6))
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D5:D15Cell Value=0textNO
D5:D15Cell Value<0textNO
D5:D15Cell Value>0textNO
B6:B15Cell Value=0textNO
B6:B15Cell Value<0textNO
B6:B15Cell Value>0textNO


VBA Code: 
Sub MySubroutine()
    Dim newTblName As String
    Dim todaysDate As String
    Dim oldDateColumnHeader As String
    Dim Tbl As ListObject
    
    ' Get today's date in the required format
    todaysDate = Format(Date, "dd/mm/yyyy")
      
    ' Get a reference to the "Weekly Change" worksheet
    Set ws = ThisWorkbook.Worksheets("Weekly Change")
    
    ' Get a reference to the table
    Set Tbl = ActiveSheet.ListObjects("WklyChange")
    
    ' Get the index of the last column in the table
    lastColumn = Tbl.ListColumns.Count
    'MsgBox ("lastColumn = " & lastColumn)
    
    ' Select the last two columns and Copy
    Tbl.ListColumns(lastColumn - 1).DataBodyRange.Resize(, 2).Select
    Selection.Copy
    
    ' Set the target range to the first blank column after the table which starts in column A on row 5
    ws.Cells(5, lastColumn + 1).Select
    Do Until ActiveCell.Value = ""
        ActiveCell.Offset(0, 1).Select
    Loop
    
    ' Insert the copied columns to the right of the target range
    Selection.Insert Shift:=xlToRight
    
    ' Resize the column widths of the inserted columns and the last column of the table
     Tbl.ListColumns(lastColumn + 1).Range.ColumnWidth = 16.29
     Tbl.ListColumns(lastColumn + 2).Range.ColumnWidth = 10
    
    ' Update the table's range
    Tbl.Resize Tbl.Range.Resize(, lastColumn + 2)
    
    ' Get the last column in the table and set the header of the last column to today's date
    Set lastCol = Tbl.ListColumns(Tbl.ListColumns.Count)
    lastCol.Name = todaysDate
    
    ' Get the old weekly change column header
    oldWeeklyChangeColumnHeader = Tbl.ListColumns(Tbl.ListColumns.Count - 3).Range.Cells(1, 1).Value
    
    ' Get the 2nd last column in the table and set the header of the 2nd last column to today's date
    Set secondLastCol = Tbl.ListColumns(Tbl.ListColumns.Count - 1)
    secondLastCol.Name = oldWeeklyChangeColumnHeader + "2"

    'Set the newTblName variable to the name of the new table
    newTblName = "Table12"
    
    ' Get the Old Date Column header
    oldDateColumnHeader = Tbl.ListColumns(Tbl.ListColumns.Count - 2).Range.Cells(1, 1).Value
    
    ' Update the formulas in the second to last column
    Tbl.ListColumns(Tbl.ListColumns.Count - 1).DataBodyRange.FormulaR1C1 = "=[@[" & todaysDate & "]]-[@[" & oldDateColumnHeader & "]]"

    ' Update the formulas in the last column
'     Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],$A6),COUNTIF(Table12[[#All],[Title]],$A6))"
    Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],[@Title]),COUNTIF(Table12[[#All],[Title]],[@Title]))"
'    Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(" & newTblName & "[[#All],[Service Name]],$A$3," & newTblName & "[[#All],[Title]],$A6),COUNTIF(" & newTblName & "[[#All],[Title]],$A6)"

'    lastCol.DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],$A6),COUNTIF(Table12[[#All],[Title]],$A6))"
'    lastCol.DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],[@Title]),COUNTIF(Table12[[#All],[Title]],[@Title]))"
'    lastCol.DataBodyRange.FormulaR1C1 = "=IF($A$3<>"",COUNTIFS(" & newTblName & "[[#All],[Service Name]],$A$3," & newTblName & "[[#All],[Title]],$A6),COUNTIF(" & newTblName & "[[#All],[Title]],$A6)"

End Sub

Thank you
 
Upvote 0
You should be using Formula not FormulaR1C1 since your formula is in A1 style.
 
Upvote 0
@RoryA - thanks for the guidance - I will check this again tomorrow - my initial check just replacing 'FormulaR1C1' with 'Formula' still results in the Run-time error for any of the lines under 'Update the formulas in the last column' but the top line still works with either FormulaR1C1 or Formula.

VBA Code: 
    ' Update the formulas in the second to last column
    Tbl.ListColumns(Tbl.ListColumns.Count - 1).DataBodyRange.Formula = "=[@[" & todaysDate & "]]-[@[" & oldDateColumnHeader & "]]"

    ' Update the formulas in the last column
     Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.Formula = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],$A6),COUNTIF(Table12[[#All],[Title]],$A6))"
'    Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.Formula = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],[@Title]),COUNTIF(Table12[[#All],[Title]],[@Title]))"
'    Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.Formula = "=IF($A$3<>"",COUNTIFS(" & newTblName & "[[#All],[Service Name]],$A$3," & newTblName & "[[#All],[Title]],$A6),COUNTIF(" & newTblName & "[[#All],[Title]],$A6)"

'    lastCol.DataBodyRange.Formula = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],$A6),COUNTIF(Table12[[#All],[Title]],$A6))"
'    lastCol.DataBodyRange.Formula = "=IF($A$3<>"",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],[@Title]),COUNTIF(Table12[[#All],[Title]],[@Title]))"
'    lastCol.DataBodyRange.Formula = "=IF($A$3<>"",COUNTIFS(" & newTblName & "[[#All],[Service Name]],$A$3," & newTblName & "[[#All],[Title]],$A6),COUNTIF(" & newTblName & "[[#All],[Title]],$A6)"
 
Upvote 0
You also need to double any quotes that are part of the actual formula, so:

VBA Code: 
Tbl.ListColumns(Tbl.ListColumns.Count).DataBodyRange.Formula = "=IF($A$3<>"""",COUNTIFS(Table12[[#All],[Service Name]],$A$3,Table12[[#All],[Title]],$A6),COUNTIF(Table12[[#All],[Title]],$A6))"

I don't really know why you are using [#All] in the formulas though - why do you need to include the header rows?
 
Upvote 0
Solution
@RoryA - Thank you - frustrating regards the double quoting - I had that in place and removed it at some point whilst trying to get the formula working.

The tables in my full spreadsheet are much larger than the examples above with the sequence of columns sometimes changing so refering to the Header rows is ,my way of accounting for this.
 
Upvote 0
That doesn't make any sense to me. All you are doing is including the header row for a specified column in your COUNTIF(s) formulas. Unless that row needs to be counted for some reason, there's no point.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
VBA Run-time Errors
Replies
3
Views
506
StephenCrump
S
S
  • Question
"Subscript out of range ( Run time Error: 09)" Problem in My Excel VBA
Replies
5
Views
247
6StringJazzer
6StringJazzer
L
  • Question
VBA to export recurring meeting data
Replies
1
Views
560
John_w
J
P
  • Question
Signature is being removed when I run the rest of my VBA
Replies
3
Views
146
rollis13
rollis13
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
338
Agnarr
Agnarr

Forum statistics

Threads
1,214,644
Messages
6,120,709
Members
448,983
Latest member
Joaquim_Baptista

Share this page

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