Number1Rock
Number1Rock

Reputation: 53

How to select last populated cell in table column

I am learning how to use macros/vba and used the record macros function to understand how this works. For the part "Range("A31").Activate" how do I make it select the last populated cell? Since this column changes everyday- I would like to the code copy the data from this table to another.

Sub PurshToOutput()
    Range("Inputtable[[#Headers],[UPC]]").Select
    Selection.End(xlDown).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range("Inputtable[UPC]").Select
    Range("A31").Activate
    Selection.Copy
    Sheets("OUTPUT").Select
    Range("Outputtable[UPC]").Select
    ActiveSheet.Paste
End Sub

Upvotes: 1

Views: 950

Answers (3)

FaneDuru
FaneDuru

Reputation: 42236

Selecting, activating only consumes Excel resources not bringing any benefit. When record a macro, Excel show selections only because they have been done and they have been recorded, not because they are necessary. Obtaining the last cell on a specific column in a specific ListObject can be done in the next way:

Sub lastCellInTableColumn()
   Dim lastCellUPC As Range
   Set lastCellUPC = Range("Outputtable[UPC]").cells(Range("Outputtable[UPC]").Rows.count, 1)
   Debug.Print lastCellUPC.Address, lastCellUPC.Value
End Sub

If you want copying only the last cell (of UPC column) value, in all UPC column of the second table, you can simple use:

Range("Inputtable[UPC]").cells(Range("Inputtable[UPC]").Rows.count, 1).Copy _
                                    Sheets("OUTPUT").Range("Outputtable[UPC]")

Edited:

In order to copy all the column content you can use the next way(s). Since the table names should be unique, it is not necessare to use the sheet name where they lies:

   Range("Inputtable[UPC]").Copy Range("Outputtable[UPC]").cells(1) 'copy all column

A better way (faster and needing less resources) is using arrays, since the format in tables is rather similar. The clipboard will not be involved, anymore. The above copying way can be replaced by this more efficient way:

Dim arr: arr = Range("Inputtable[UPC]").Value
    Range("Outputtable[UPC]").cells(1).resize(UBound(arr), 1).Value = arr

Now, if the column is not full and you need copying only the existing range, you can use the next way:

    Dim lastC As Range, arr
    Set lastC = lastUsedTblCell(Range("Inputtable[UPC]"))

    If Not lastC Is Nothing Then
         arr = Range(Range("Inputtable[UPC]").cells(1), lastC).Value
         If IsArray(arr) Then
            Range("Outputtable[UPC]").cells(1).resize(UBound(arr), 1).Value = arr
         Else
            Range("Outputtable[UPC]").cells(1).Value = arr
         End If
    End If

Function lastUsedTblCell(tblRng As Range) As Range
   Dim lastC As Range
   Set lastC = tblRng.Find(what:="*", After:=tblRng.cells(1), LookIn:=xlValues, searchOrder:=xlByRows, SearchDirection:=xlPrevious)
   If Not lastC Is Nothing Then
        Set lastUsedTblCell = lastC
    End If
End Function

If you want/need proceeding in a similar way related to the second table column, meaning to paste in its first empty row, you can use the following way (using the function from above, too):

Dim lastC As Range, arr
    Set lastC = lastUsedTblCell(Range("Inputtable[UPC]"))

    Dim lastCOut As Range
    Set lastCOut = lastUsedTblCell(Range("Outputtable[UPC]"))
    If lastCOut Is Nothing Then Set lastCOut = Range("Outputtable[UPC]").cells(1).Offset(-1)

    If Not lastC Is Nothing Then
         arr = Range(Range("Inputtable[UPC]").cells(1), lastC).Value
         If IsArray(arr) Then
            lastCOut.Offset(1).resize(UBound(arr), 1).Value = arr
         Else
            lastCOut.Offset(1).Value = arr
         End If
    End If
End Sub

In this last case, if the number of pasted rows will be bigger than the table rows, the table will be extended with the necessary rows.

If something unclear, please do not hesitate to ask for clarifications.

Upvotes: 1

VBasic2008
VBasic2008

Reputation: 54807

Copy Excel Table Column (ListColumn)

  • This will append the data from one table's column to another table's column. Hopefully, the remaining columns of the latter table have formulas, that will get updated, for this to make sense.
  • The first 4 rows of the Input section illustrate how to reference the various objects hierarchically while the last 4 rows illustrate how to reference the last non-blank cell (ilCell) and the range (irg) from the first column cell to the last non-blank cell.
Option Explicit

Sub PurshToOutput()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Input
    Dim iws As Worksheet: Set iws = wb.Worksheets("INPUT")
    Dim itbl As ListObject: Set itbl = iws.ListObjects("Inputtable")
    Dim ilcl As ListColumn: Set ilcl = itbl.ListColumns("UPC")
    Dim irg As Range: Set irg = ilcl.DataBodyRange
    ' The Last Non-Blank Cell
    Dim ilCell As Range: Set ilCell = irg.Find("*", , xlValues, , , xlPrevious)
    If ilCell Is Nothing Then Exit Sub ' no data in column
    Dim irCount As Long: irCount = ilCell.Row - irg.Row + 1
    ' The Range From the First Cell to the Last Cell
    Set irg = irg.Resize(irCount)
    
    ' Output
    Dim ows As Worksheet: Set ows = wb.Worksheets("OUTPUT")
    Dim otbl As ListObject: Set otbl = ows.ListObjects("Outputtable")
    Dim olcl As ListColumn: Set olcl = otbl.ListColumns("UPC")
    Dim ofcell As Range
    With olcl.DataBodyRange
        Set ofcell = .Cells(.Cells.Count).Offset(1)
    End With
    Dim org As Range: Set org = ofcell.Resize(irg.Rows.Count)
    
    ' Copy by Assignment
    org.Value = irg.Value
    
End Sub

Upvotes: 1

swastika sanyal
swastika sanyal

Reputation: 51

The problem with your code is that it is bringing unnecessary complication in my opinion. All you have to do is select the column header for which you need the last cell value. Go to the last cell, copy & paste it in the desired locaion.

You can try this to copy the last cell value:

Range("inputtable[[#Headers],[UPC]]").Select
   Selection.End(xlDown).Select
   Selection.Copy

Upvotes: 1

Related Questions