I am trying to do the following:
- Check each row if "Order" column is empty in table1 from sheet1 (there is only one table in this sheet)
- if it is "Order" column is empty, copy the "Notification" number from the same row AND then paste it into a new row of a table (table2) in another sheet (sheet2) under column "Notification".
- if it is not empty, go to the next row in table1
I have the following code so far:
For Each TCell in Range ("Table1").ListObject.ListColumns("Order").DataBodyRange.Cells
If TCell.Value="" then
Table2.ListRows.Add AlwaysInsert:=True
Range(TCell.Row, "Notification").Copy Range("Table2") .ListObject. ListColumns ("Notification"
.DataBodyRange.End(xlDown).Offset (1,0)
End if
Next TCell
Any help would be greatly appreciated! Thanks.
CodePudding user response:
Append Table's Column to Another Table's Column
- This is a basic solution that 'literally' does what is required (slow). By using object variables, it illustrates their application.
- You could increase efficiency by introducing arrays, or especially by using
AutoFilter.
Option Explicit
Sub AppendNotifications()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
Dim stbl As ListObject: Set stbl = sws.ListObjects("Table1")
Dim slcl As ListColumn: Set slcl = stbl.ListColumns("Order")
Dim svcl As ListColumn: Set svcl = stbl.ListColumns("Notification")
Dim scOffset As Long: scOffset = svcl.Index - slcl.Index
Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
Dim dtbl As ListObject: Set dtbl = dws.ListObjects("Table2")
Dim dvcl As ListColumn: Set dvcl = dtbl.ListColumns("Notification")
Dim dvCol As Long: dvCol = dvcl.Index
Dim sCell As Range
Dim dvrw As ListRow
For Each sCell In slcl.DataBodyRange
If Len(sCell.Value) = 0 Then
Set dvrw = dtbl.ListRows.Add
dvrw.Range(dvCol).Value = sCell.Offset(, scOffset).Value
End If
Next sCell
MsgBox "Notifications appended.", vbInformation
End Sub
CodePudding user response:
Could try below codes:
Sub transform()
Dim cell As Range
Set rng1 = Sheet1.Range("Table1[Order]")
Set SheetTwo = ActiveWorkbook.Worksheets("Sheet2")
Set TableTwo = SheetTwo.ListObjects("Table2")
For Each cell In rng1
If Not IsEmpty(cell.Offset(0, 0).Value) Then
Dim newrow As ListRow
Set newrow = TableTwo.ListRows.Add
With newrow
.Range(1) = cell.Offset(0, 1).Value
End With
End If
Next cell
End Sub
Codes are self-explanatory.
Notes: Table2 only has a column.
