VBA - With each table on Activesheet

Finalfight40

Active Member
Joined
Apr 24, 2018
Messages
273
Office Version
  1. 365
Platform
  1. Windows
Hi

I am trying to set something up in VBA where it would cycle through each table on the Activesheet and if the 3rd column header says "Start Date" then add 7 for each element on the 3rd column of that table.

How would this be written in VBA?
 
Last edited:

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Perhaps something like this.
Code:
Sub Add7ToStartDate()
Dim tbl As ListObject
Dim col As ListColumn
Dim rng As Range
Dim arrData As Variant
Dim idx As Long

    For Each tbl In ActiveSheet.ListObjects
    
        If tbl.ListColumns.Count > 2 Then
        
            If tbl.ListColumns(3).Name = "Start Date" Then
            
                Set rng = tbl.ListColumns(3).DataBodyRange
                
                arrData = rng.Value
                
                For idx = LBound(arrData) To UBound(arrData)
                
                    arrData(idx, 1) = arrData(idx, 1) + 7
                Next idx
                
                rng.Value = arrData
                
            End If
            
        End If
    Next tbl
    
End Sub
 
Upvote 0
o Norie.

Thank you so much this works perfectly.

I haven't had any experience with tables in VBA so i really appreciate it.
 
Upvote 0
Another option without cycling through each row value in the relevant tables I think still does what you want.

Rich (BB code):
Sub Add_7_To_Start_Date()
  Dim LO As ListObject
  
  With Cells(Rows.Count, Columns.Count)
    .Value = 7
    .Copy
    For Each LO In ActiveSheet.ListObjects
      If LO.ListColumns.Count > 2 Then
        If LO.ListColumns(3).Name = "Start Date" Then LO.ListColumns(3).DataBodyRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
      End If
    Next LO
    .ClearContents
  End With
End Sub
 
Last edited:
Upvote 0
Another option without cycling through each row value in the relevant tables I think still does what you want.

Rich (BB code):
Sub Add_7_To_Start_Date()
  Dim LO As ListObject
  
  With Cells(Rows.Count, Columns.Count)
    .Value = 7
    .Copy
    For Each LO In ActiveSheet.ListObjects
      If LO.ListColumns.Count > 2 Then
        If LO.ListColumns(3).Name = "Start Date" Then LO.ListColumns(3).DataBodyRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
      End If
    Next LO
    .ClearContents
  End With
End Sub


Hi Peter

For one of my tables i got an error which was :

Paste method of range class failed and i have changed to red above where this error was received.

Also i am going to explain a little more in my next post. I am not doing it in this 1 as i replied to you and don't want Norie or anyone else to skip over it.Also i am going to explain a little more in my next post. I am not doing it in this 1 as i replied to you and don't want Norie or anyone else to skip over it.
 
Upvote 0
Hi Norie and all

I have had an run time error '91'.

I believe this is where the tables are currently empty.

I want to expand and mention that these tables can have nothing in them. Also the table might currently only have 1 element in it. The final thing to mention is that the tables might be populated with 100 rows but have some elements in this column which are blank which i do not want to change.
 
Upvote 0
I believe this is where the tables are currently empty.

I want to expand and mention that these tables can have nothing in them. Also the table might currently only have 1 element in it. The final thing to mention is that the tables might be populated with 100 rows but have some elements in this column which are blank which i do not want to change.
These are all relevant facts.
Does this do any better?

Rich (BB code):
Sub Add_7_To_Start_Date()
  Dim LO As ListObject
  
  For Each LO In ActiveSheet.ListObjects
    If LO.ListColumns.Count > 2 Then
      If LO.ListColumns(3).Name = "Start Date" Then
        With LO.ListColumns(3).DataBodyRange
          .Value = Evaluate(Replace("if(#="""","""",#+7)", "#", .Address))
        End With
      End If
    End If
  Next LO
End Sub
 
Upvote 0
These are all relevant facts.
Does this do any better?

Rich (BB code):
Sub Add_7_To_Start_Date()
  Dim LO As ListObject
  
  For Each LO In ActiveSheet.ListObjects
    If LO.ListColumns.Count > 2 Then
      If LO.ListColumns(3).Name = "Start Date" Then
        With LO.ListColumns(3).DataBodyRange
          .Value = Evaluate(Replace("if(#="""","""",#+7)", "#", .Address))
        End With
      End If
    End If
  Next LO
End Sub

Thank you Peter. This works perfectly for me at the moment, i will let you know if i run into any issues.

I was unaware the 1 element and no elements were going to be relevant.

As for the blanks i was hoping to try to adapt what someone provided so that i could learn to adapt what was provided. This i managed but when i got the error above i thought now i better provide everything just to be sure.
 
Upvote 0
You're welcome. Hope it is robust for you. :)

Hi Peter

i have just found that on some sheets i am receiving a run time error '91' and the line that is being highlighted is:

Code:
.Value = Evaluate(Replace("if(#="""","""",#+7)", "#", .Address))

Do you know what might be causing such a thing?
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,293
Members
448,564
Latest member
ED38

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