Improving range references to Table rows (dynamic instead of fixed)

[GTS]

Hello,

The following is part of a larger macro. The end result is that I want to take the currently selected (active) row and move it to the top of the table (row 9 in my case). I'm doing this by inserting a blank row at the top, then copying the active row to the blank row at the top, then deleting the original row.

1) There is probably a cleaner way to do this. Eg How would I simply "move active row to top"?
2) I'm referencing exact columns in my ranges. eg A9:BA9. If the table size changes (new column added) or header row moves, then this macro segment fails. I'm struggling with how to reference the table row dynamically. My table name is Cap_Equip. Worksheet name is Cap Equip. Something along the line of ThisWorkbook.Worksheets("Cap Equip").Range("Cap_Equip[Active Row]") and ThisWorkbook.Worksheets("Cap Equip").Range("Cap_Equip[First Data Row]")

Appreciate the help.

Dim Tbl As ListObject
   On Error Resume Next
   Set Tbl = Selection.ListObject
   On Error GoTo 0
  
   Dim rowCurrent As Long
    rowCurrent = Selection.Row
    newCurrent = rowCurrent + 1
    
    If rowCurrent <> 8 And rowCurrent <> 9 And Not Tbl Is Nothing Then 'Checking not on header or row 1.
        Range("A9:BA9").Insert Shift:=xlDown 'insert blank row at top
        Range("A" & newCurrent & ":BA" & newCurrent).Copy Destination:=Range("A9:BA9") 'copy selected row to top of table
        Range("A" & newCurrent).Delete 'delete the row that has been copied to the top
    End If

 

[RoryA]

Tbl.ListRows.Add(1) will insert a new row at the top of the table and return a ListRow object that you can use to copy to.

 

[GTS]

Thanks Rory. I see how that works for my first line of code after the IF - It inserts a blank row at the top of the table, very nice.
I'm lost though with the second part of your answer, and how I can adapt the next 2 lines of code so that they will work regardless of the # of columns in the table.
Sorry, but my coding skills are limited.

 

[RoryA]

Something like this:

   Dim Tbl As ListObject
   On Error Resume Next
   Set Tbl = Selection.ListObject
   On Error GoTo 0
  
   If Not Tbl Is Nothing Then
      Dim rowCurrent As Long
      rowCurrent = ActiveCell.Row - Tbl.DataBodyRange.Row + 1
      
      If rowCurrent > 1 Then 'Checking not on header or row 1.
         Dim newRow As ListRow
         Set newRow = Tbl.ListRows.Add(1)
         With Tbl.ListRows(rowCurrent + 1)
            .Range.Copy newRow.Range(1)
            .Delete
         End With
      End If
   End If

 

[GTS]

Wow... Wish I could write code like that. Works perfectly, thank you so much.
MrExcel forums are the best.

 

[RoryA]

Glad we could help.