Credit for code is for few editors in Mr . Excel forum. This code works like a charm, but I need it to copy the entire row of the new data, rather than only values from column A. Now I tried to play with true and false statements and etc. but to no avail, I believe it is out of my scope and id like so suggestions or assistance how to achieve my mission. I have simple values, no formulas, just some named columns and thousands of rows in original file and extract file.
Sub AddMissingItems()
Dim Dic As Object
Dim Arr() As Variant, outArr() As Variant
Dim i As Long, k As Long, iRow As Long
Dim c as long
Set Dic = CreateObject("Scripting.dictionary")
With Sheets("Sheet1")
c = .Cells(1, Columns.Count).End(xlToLeft).Column
Arr = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
For i = 1 To UBound(Arr, 1)
If Dic.exists(Arr(i, 1)) = False Then
Dic.Add (Arr(i, 1)), ""
End If
Next
End With
With Workbooks("ExtractFile").Worksheets("Sheet1")
Arr = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
ReDim outArr(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
If Dic.exists(Arr(i, 1)) = False Then
k = k 1
outArr(k, 1) = Arr(i, 1)
End If
Next
End With
iRow = Sheets("Sheet1").Range("A" & Rows.Count).End(3).Row 1
If k <> 0 Then
Sheets("Sheet1").Range("A" & iRow).Resize(k).Value = outArr
k = 0
End If
End Sub
Tried adding Entirerow statement to several places, but to no avail.
CodePudding user response:
Please, try the next adapted code. I commented where I input new variables/code lines:
Sub AddMissingItems()
Dim Dic As Object, Arr() As Variant, outArr() As Variant
Dim i As Long, k As Long, iRow As Long, c As Long
Dim r As Long, j As Long
Set Dic = CreateObject("Scripting.dictionary")
With Sheets("Sheet1")
Arr = .Range("A1:A" & .Range("A" & .rows.count).End(xlUp).row).Value
For i = 1 To UBound(Arr, 1)
If Dic.Exists(Arr(i, 1)) = False Then
Dic.Add (Arr(i, 1)), ""
End If
Next
End With
With Workbooks("ExtractFile.xlsx").Worksheets("Sheet1")
c = .cells(1, Columns.count).End(xlToLeft).column
r = .Range("A" & .rows.count).End(xlUp).row 'calculate the last row in A:A, too
Arr = .Range("A1", .cells(r, c)).Value 'place in the array all existing columns
ReDim outArr(1 To UBound(Arr), 1 To c) 'extend the redimmed array to all columns
For i = 1 To UBound(Arr)
If Dic.Exists(Arr(i, 1)) = False Then
k = k 1
For j = 1 To c 'iterate between all array columns:
outArr(k, j) = Arr(i, j) 'place the value from each column
Next j
End If
Next
End With
iRow = Sheets("Sheet1").Range("A" & rows.count).End(3).row 1
If k <> 0 Then
Sheets("Sheet1").Range("A" & iRow).Resize(k, UBound(Arr, 2)).Value = outArr 'resize by columns, too
k = 0
End If
End Sub
Please, send some feedback after testing it.