VBA - With each table on Activesheet

[Finalfight40]

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?

 

[Norie]

Perhaps something like this.

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]

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]

Another option without cycling through each row value in the relevant tables I think still does what you want.

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

 

[Finalfight40]

Another option without cycling through each row value in the relevant tables I think still does what you want.

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]

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]

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?

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]

These are all relevant facts.
Does this do any better?

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.

 

[Peter_SSs]

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

You're welcome. Hope it is robust for you.

 

[Finalfight40]

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:

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

Do you know what might be causing such a thing?