VBA - With each table on Activesheet

Finalfight40

Board Regular
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:

Norie

Well-known Member
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

Board Regular
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
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

Board Regular
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

Board Regular
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
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

Board Regular
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

Board Regular
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?
 

Some videos you may like

This Week's Hot Topics

Top