Click Button Excel 2013 Copy rows from one excel table to another based on cell value

Question

I'm quite new to VBA and have been struggling to find any existing info with the following:

I have a workbook (excel 2013) with a table (excel Table) containing data / text etc. like a master project list. On several other sheets I have similar tables with similar data but for sub-projects. What I am trying to do is have a click button on the main page with the master project list (first sheet) where once clicked it will check the tables on the other sheets (sub-projects) for rows with a yes in column 1 and copy each row (with a yes) to the next available row in the master project table. There is a unique reference in column 2 that must be checked so it doesn't duplicate rows.

I have started playing around with some code I found on here but it's for copying to a new sheet, not a table, and obviously is only part of the function I'm trying to implement.

Sub Button2_Click()
Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = 10
pasteRowIndex = 1

For r = 1 To endRow

    If Cells(r, Columns("B").Column).Value = "yes" Then
    Rows(r).Select
    Selection.Copy

    'Switch to the sheet where you want to paste it & paste
    Sheets("Sheet2").Select
    Rows(pasteRowIndex).Select
    ActiveSheet.Paste

    'Next time you find a match, it will be pasted in a new row
    pasteRowIndex = pasteRowIndex + 1


    'Switch back to your table & continue to search for your criteria
    Sheets("Sheet1").Select
    End If
Next r
End Sub

Any help with this would be much appreciated.

Answer 1

There are two major things to consider here:

1. How to add a row from one table to another?
2. How to find out if that row already exists in the table?

Adding a new row to a table

Tables can save you some work as you don't have to find the last row. To add a new row to a table from a Range object, you could do something along the lines of the following sample function.

' Inserts a row to the table from a range object.
Private Function InsertTableRowFromRange(table As ListObject, source As Range)

  Dim newRow As ListRow

  Set newRow = table.ListRows.Add(AlwaysInsert:=True)
  newRow.Range(1, 1).Resize(source.Rows.Count, source.Columns.Count) _
        .Value = source.Value

End Function

You could then loop over the rows in other tables and insert the ranges that fit the bill.

' Inserts toggled rows from the source table to the target table.
Private Function InsertToggledRows(source As ListObject, target As ListObject)

  Dim row As ListRow

  For Each row In source.ListRows
    If row.Range(1, 1).Value = "yes" Then
      InsertTableRowFromRange target, row.Range
    End If
  Next

End Function

What about the duplicates?

There are many ways to handle duplicates with VBA - there are also a few different scenarios that you might have to think about. Consider the following situation for example:

The item with an index of 8 is set to yes in two different tables and has a different name in each table. Which table should be used? What about when an item is set to yes in one table and no in another?

---

For the result in the above screenshot, I added the indexes from the master table to an array and used a function from this answer to compare potential new indexes to the ones in the array.

Some changes were also required for InsertToggledRows as it now also has to update the indexes array. The path I took in the following example involves some awkward return values and isn't the only way of doing things.

Example Setup

Option Explicit

' Inserts toggled rows with unique identifiers from other tables to the master.
Public Sub InsertTablesToMasterTable()

  Application.ScreenUpdating = False

  Dim ws As Worksheet
  Dim masterTable As ListObject
  Dim firstTable As ListObject
  Dim secondTable As ListObject
  Dim indexes() As Variant

  Set ws = ThisWorkbook.Worksheets(1)
  ' Set your table objects to variables
  With ws
    Set masterTable = .ListObjects("Master")
    Set firstTable = .ListObjects("Table1")
    Set secondTable = .ListObjects("Table2")
  End With

  ' Get the indexes from the existing table
  indexes = GetInitialIndexes(masterTable)

  ' Insert the rows & update the indexes array
  indexes = InsertUniqueToggledRows(firstTable, masterTable, indexes)
  indexes = InsertUniqueToggledRows(secondTable, masterTable, indexes)

  Application.ScreenUpdating = True

End Sub

' Returns an array of the initial indexes found in the table.
Private Function GetInitialIndexes(table As ListObject) As Variant

  Dim arr() As Variant
  ReDim arr(0 To table.ListRows.Count)
  Dim row As ListRow
  Dim i As Integer

  i = 0
  For Each row In table.ListRows
    arr(i) = row.Range(1, 2).Value
    i = i + 1
  Next

  GetInitialIndexes = arr

End Function

' Inserts toggled rows from the source table to the target table and returns
' an array which has the new indexes appended to the existing array.
Private Function InsertUniqueToggledRows( _
                                          source As ListObject, _
                                          target As ListObject, _
                                          indexes As Variant _
                                        ) As Variant

  Dim arr() As Variant
  Dim row As ListRow

  arr = indexes

  For Each row In source.ListRows
    If row.Range(1, 1).Value = "yes" And _
    Not IsInArray(row.Range(1, 2).Value, indexes) Then
      InsertTableRowFromRange target, row.Range

      ' Push the new index to the array
      ReDim Preserve arr(0 To UBound(arr) + 1) As Variant
      arr(UBound(arr)) = row.Range(1, 2).Value
    End If
  Next

  InsertUniqueToggledRows = arr

End Function

' Inserts a row to the table from a range object.
Private Function InsertTableRowFromRange(table As ListObject, source As Range)

  Dim newRow As ListRow

  Set newRow = table.ListRows.Add(AlwaysInsert:=True)
  newRow.Range(1, 1).Resize(source.Rows.Count, source.Columns.Count) _
        .Value = source.Value

End Function

' Returns true if the string is found in the array.
Private Function IsInArray(stringToFind As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToFind)) > -1)
End Function