Reputation: 53
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
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
Reputation: 54807
ListColumn
)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
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