VBA - With each table on Activesheet

Finalfight40

Active Member
Joined
Apr 24, 2018
Messages
273
Office Version
365
Platform
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:

Some videos you may like

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,466
Office Version
365
Platform
Windows
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
 

Finalfight40

Active Member
Joined
Apr 24, 2018
Messages
273
Office Version
365
Platform
Windows
o Norie.

Thank you so much this works perfectly.

I haven't had any experience with tables in VBA so i really appreciate it.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
43,650
Office Version
365
Platform
Windows
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:

Finalfight40

Active Member
Joined
Apr 24, 2018
Messages
273
Office Version
365
Platform
Windows
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.
 

Finalfight40

Active Member
Joined
Apr 24, 2018
Messages
273
Office Version
365
Platform
Windows
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.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
43,650
Office Version
365
Platform
Windows
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
 

Finalfight40

Active Member
Joined
Apr 24, 2018
Messages
273
Office Version
365
Platform
Windows
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.
 

Finalfight40

Active Member
Joined
Apr 24, 2018
Messages
273
Office Version
365
Platform
Windows
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,090,055
Messages
5,412,091
Members
403,411
Latest member
aspofford

This Week's Hot Topics

Top