Excel Table - vba code to delete data and clear content

[Dancarro]

Hi,

I am struggling with vba code which is supposed to do the following:

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Employee[/TD]
[TD]Region[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]John[/TD]
[TD]Spain[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Mike[/TD]
[TD]UK[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Peter[/TD]
[TD]Germany[/TD]
[TD]30[/TD]
[/TR]
</tbody>[/TABLE]

In the TABLE (not range) I need that row 3 until last row is deleted and that the second row for columns ID:Region that this row is cleared content; column Sales has formula based on the three first columns

I have the following code which is not working:

Sub Test()




Dim loSource As Excel.ListObject
Dim laSource As Excel.ListObject

Set loSource = Sheets("Sales").ListObjects("Table1")
loSource.ListObjects(2).DataBodyRange.Delete Shift:=xlShiftUp


Set laSource = Sheets("Sales").ListObjects("Table1")
laSource.ListColumns.Range("Table1[[ID]:[Region]]").Select
Selection.ClearContents

End Sub

Thank you

 

[Yongle]

Is this what you want?
It clears the whole table, leaving only the headers and first row formulas

Test on a copy of your worksheet

Sub ClearTable()
    Dim T As ListObject:    Set T = ActiveSheet.ListObjects(1)
    With T.DataBodyRange
        If .Rows.Count > 1 Then .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        On Error Resume Next
        .Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
    End With
End Sub

 

[John_w]

In the TABLE (not range) I need that row 3 until last row is deleted and that the second row for columns ID:Region that this row is cleared content; column Sales has formula based on the three first columns

Try this:

Public Sub Delete_Rows_and_Clear_Cells_In_Table()
    
    Dim table As ListObject
    
    Set table = Sheets("Sales").ListObjects("Table1")
    
    With table
        'Delete 3rd data row to last data row
        .DataBodyRange.Rows("3:" & .ListRows.Count).Delete
        
        'Clear first 3 cells on 2nd data row
        .DataBodyRange(2, 1).Resize(1, 3).ClearContents
    End With
    
End Sub

 

[Dancarro]

Hi Yongle and John,

I tried both of your codes and both worked perfectly

Thank you so much

 

[Yongle]

thanks for the feedback

 

[macainac]

Is this what you want?
It clears the whole table, leaving only the headers and first row formulas

Test on a copy of your worksheet

Sub ClearTable()
    Dim T As ListObject:    Set T = ActiveSheet.ListObjects(1)
    With T.DataBodyRange
        If .Rows.Count > 1 Then .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        On Error Resume Next
        .Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
    End With
End Sub

Hi Yongle,

How can I make this code work on three tables on different sheets?

Thank you