I have a table of source data like this:
ID | Color |
---|---|
B12 | Blue |
C14 | Yellow |
J14 | Jaune |
And I have a named table (in another sheet) where I'd like to send data that looks like this (same structure as source data):
ID | Color |
---|
I want the vba code to do the following:
It is important that the code never removes rows from the target table. ie if the source data is updated and a row is removed, the target table should still contain any removed rows. so rows can only be added to the target table, or updated if there are matching case IDs in both tables.
EDIT:
here is an answer from another stack question. though I have no clue how to adapt this code to fit my needs:
' COPY, PASTE AND APPEND
Sub Append()
Dim manager As String, lastrow As Long, i As Integer, k as integer, j as integer
Dim find As Range, bill As String
bill = Sheets("Sheet1").Range("A:A").Value
Do While Not bill = ""
Set find = Sheets("Sheet1").Range("A:A").find(what:=bill, lookat:=xlValues, lookat:=xlWhole)
If find Is Nothing Then
lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row
For i = 2 To lastrow
If Cells(i, 2) = "JOHN" Then
Range(Cells(i, 1), Cells(i, 6)).copy
Sheets("Sheet13").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next i
For j = 2 To lastrow
If Sheets("Sheet1").Cells(j, 2) = "CHARLIE" Then
Sheets("Sheet1").Range(Cells(j, 1), Cells(j, 6)).copy
Sheets("Sheet11").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next j
For k = 2 To lastrow
If Sheets("Sheet1").Cells(k, 2) = "GEORGE" Then
Sheets("Sheet1").Range(Cells(k, 1), Cells(k, 6)).copy
Sheets("Sheet12").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next k
Else
Sheets("Sheet1").Select
End If
Loop
End Sub
The above script first looks for manager names in the source data and then copies the data to sheets according to the manager names (which I don't need to do, since all my source data should be pasted to the same sheet). also, I don't think the above script is updating any records, which I need to do in my target table.
Dictionary
object is a good option for you.
Sub demo()
Dim srcSht As Worksheet, desSht As Worksheet
Dim arrDes, arrSrc, objDic
Dim i As Long, j As Long
' Update sheet name as needed
Set srcSht = Sheets("Sheet1") ' source sheet
Set desSht = Sheets("Sheet2") ' dest. sheet
' Load data into array
arrSrc = srcSht.[a1].CurrentRegion.Value
arrDes = desSht.[a1].CurrentRegion.Value
Set objDic = CreateObject("scripting.dictionary")
' Add data to dict object from dest table
For i = 1 To UBound(arrDes)
objDic(arrDes(i, 1)) = arrDes(i, 2)
Next
' Update / insert data into dict object
For i = 1 To UBound(arrSrc)
objDic(arrSrc(i, 1)) = arrSrc(i, 2)
Next
' write data to dest table
desSht.Range("A1").Resize(objDic.Count, 1) = Application.Transpose(objDic.keys)
desSht.Range("B1").Resize(objDic.Count, 1) = Application.Transpose(objDic.items)
Set objDic = Nothing
End Sub
Update
Question: there are about ~20 columns and it is possible that the number of columns might change, so I need to know how to modify the script to pick up additional columns
Note: The code supports multiple key columns, but they must be the first N contiguous columns. You can adjust the number of key columns by modifying the constant KEY_COL_CNT as necessary.
Option Explicit
Sub demo()
Dim srcSht As Worksheet, desSht As Worksheet
Dim arrDes, arrSrc, arrRes()
Dim objDic, arrItem, sKey As String
Dim i As Long, j As Long, ColCnt As Long
Const KEY_COL_CNT As Integer = 2 ' # of key columns
' Update sheet name as needed
Set srcSht = Sheets("Sheet1") ' source sheet
Set desSht = Sheets("Sheet2") ' dest. sheet
' Load data into array
arrSrc = srcSht.[a1].CurrentRegion.Value
arrDes = desSht.[a1].CurrentRegion.Value
ColCnt = UBound(arrDes, 2)
Set objDic = CreateObject("scripting.dictionary")
' Add data to dict object from dest table
For i = 1 To UBound(arrDes)
sKey = ""
For j = 1 To KEY_COL_CNT
sKey = sKey & "|" & arrDes(i, j)
Next
objDic(sKey) = Application.Index(arrDes, i)
Next
' Update / insert data from src table
For i = 1 To UBound(arrSrc)
sKey = ""
For j = 1 To KEY_COL_CNT
sKey = sKey & "|" & arrSrc(i, j)
Next
objDic(sKey) = Application.Index(arrSrc, i)
Next
ReDim arrRes(objDic.Count - 1, 1 To ColCnt)
' Get items from dict object
arrItem = objDic.items
' Transform to 2D array
For i = LBound(arrItem) To UBound(arrItem)
For j = 1 To ColCnt
arrRes(i, j) = arrItem(i)(j)
Next j
Next i
' write data to dest table
desSht.Range("A1").Resize(objDic.Count, ColCnt) = arrRes
Set objDic = Nothing
End Sub
Update
Question: but is it possible to paste the data into an actual table?
Note: The only difference is expanding the table before updating cells.
ReDim arrRes(objDic.Count - 1, 1 To ColCnt)
' Get items from dict object
arrItem = objDic.items
' Transform to 2D array
For i = LBound(arrItem) To UBound(arrItem) - 1
For j = 1 To ColCnt
arrRes(i, j) = arrItem(i + 1)(j)
Next j
Next i
' write data to dest table
Dim rTab As Range
Set rTab = desSht.Range("A1").Resize(objDic.Count, ColCnt)
desSht.ListObjects(1).Resize rTab
Set rTab = desSht.Range("A2").Resize(objDic.Count - 1, ColCnt)
rTab.Value = arrRes