VBA for statement to filter

[Nole321]

I am needing some help figuring out my issue with the part of my VBA sub. I am new to this forum so if I did anything incorrect, please let me know.

Sheet1 is a continuous list of everything being recorded and kept. Sheet2 is an updated list that is retrieved, with updated lines and new lines. Within the lists in column A is a unique ID for every entry in numeric value. What is trying to attempt in the VBA below is to go through every unique ID in sheet2, look for a match in sheet1, replace that entire row values with the new values from sheet2 if there is a match, if there is no match it needs to be placed in the last blank row (+1from xlUp). I have tried other ways that are not below like using scripting.dictionary, but I am not successful so far.

Sub test()

Dim enter As Worksheet
Dim take As Worksheet
Set enter = Worksheets("Sheet1")
Set take = Worksheets("Sheet2")

Dim a1 As Long
Dim b1 As Long
Dim c1 As Long

a1 = take.Cells(Rows.Count, 1).End(xlUp).Row
b1 = enter.Cells(Rows.Count, 1).End(xlUp).Row
c1 = enter.Cells(Rows.Count, 1).End(xlUp).Row + 1

For i = 1 To a1 'this statement works fine to find the matching value to replace.
    For K = 1 To b1
        If take.Cells(i, 1) = enter.Rows(K, 1) Then
            enter.Rows(i).EntireRow = take.Rows(K).EntireRow.Value
        End If
    Next
Next

'below is other things i have tried

'For I = 1 To a1
'    For J = 1 To b1
'        If enter.Cells(J, 1) <> take.Cells(I, 1) Then
'            enter.Rows(c1).EntireRow = take.Rows(I).EntireRow.Value
'            c1 = c1 + 1
'        End If
'    Next
'Next

'For i = 1 To a1
'    For j = 1 To b1
'        If take.Cells(i, 1) = enter.Cells(j, 1) Then
'            enter.Rows(j).EntireRow = take.Rows(i).EntireRow.Value
'            GoTo Skip
'        ElseIf j = b1 Then
'            enter.Rows(c1).EntireRow = take.Rows(i).EntireRow.Value
'            c1 = c1 + 1
'        End If
'    Next
'Skip:
'Next
        
End Sub

The way I am trying to do this is resulting in my every cell that the “for” is looking at to be true for the if not equal. I’m just not able to figure out how to get around this and not have every item posted multiple time below xlUp. Any help is welcomed as I am new to this forum.

 

[DanteAmor]

Hi and welcome to MrExcel.

You don't comment on what the last column is, you just want the whole row.
The following macro considers all columns with data from both sheets, even if sheet2 could have more columns than sheet1.

Try this:

Sub UpdateSheet()
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object
  Dim i As Long, j As Long, fila As Long
  Dim lc1 As Long, lc2 As Long, lc3 As Long, lr1 As Long, lr2 As Long
  Dim sh1 As Worksheet, sh2 As Worksheet
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  Set dic = CreateObject("Scripting.Dictionary")
 
  lc1 = sh1.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  lc2 = sh2.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  lc3 = WorksheetFunction.Max(lc1, lc2)
  lr1 = sh1.Range("A" & Rows.Count).End(3).Row
  lr2 = sh2.Range("A" & Rows.Count).End(3).Row
 
  a = sh1.Range("A1", sh1.Cells(lr1, lc1)).Value
  b = sh2.Range("A1", sh2.Cells(lr2, lc2)).Value
  ReDim c(1 To lr1 + lr2, 1 To lc3)
 
  For i = 1 To UBound(a, 1)
    dic(a(i, 1)) = i
    For j = 1 To UBound(a, 2)
      c(i, j) = a(i, j)
    Next
  Next i
 
  For i = 1 To UBound(b, 1)
    If dic.Exists(b(i, 1)) Then
      fila = dic(b(i, 1))
    Else
      lr1 = lr1 + 1
      fila = lr1
    End If
    For j = 1 To UBound(b, 2)
      c(fila, j) = b(i, j)
    Next
  Next i
 
  sh1.Range("A1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub

 

[AlphaFrog]

Sub test()
    Dim cell As Range, Found As Range
    Dim enter As Worksheet
    Dim take As Worksheet
    
    Set enter = Worksheets("Sheet1")
    Set take = Worksheets("Sheet2")
    
    For Each cell In take.Range("A1", take.Range("A" & Rows.Count).End(xlUp))
    
        Set Found = enter.Columns("A").Find(cell.Value, , xlValue, xlWhole, 1, 1, 0)
        
        If Not Found Is Nothing Then
            Found.EntireRow.Value = cell.EntireRow.Value
        Else
            enter.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Value = cell.EntireRow.Value
        End If
    Next cell
            
End Sub

 

[Nole321]

Thank you both for the quick response! I Iested out both of them and I found better results using DanteAmor's.

DanteAmor, the columns can vary over time and i did want to have it cary over if there's a new column. I do have one last question for the DanteAmor if you have time. After testing your code it works perfectly except for one possibility. There are times where there will be a new unique ID and possibly an update to that same ID just a couple of spots below in sheet2 before sheet2 gets cleared out for everything that transfered to sheet1. Anything that got entered below the new ID in sheet2 with the same ID will always for an update to the new one if they happened to be entered moment apart in sheet2. As it is now, if you have a new ID and an update anywhere below it on sheet2, two new entires will be pulled to sheet1 with the same ID instead of updateing the one it pulled over. Would happen to have any ideas around this? If this does not make sense please let me know.

 

[DanteAmor]

After testing your code it works perfectly except for one possibility.

You could exemplify it.
Use the XL2BB tool to put examples here.

 

[Nole321]

Let's say here on sheet1 we have the list of data with unique IDs 1-9. Sheet1 is my retention.

test book.xlsm
	A	B	C	D	E
1	1	x	x	x
2	2	x	x	x
3	3	x	x	x
4	4	x	x	x
5	5	x	x	x
6	6	x	x	x
7	7	x	x	x
8	8	x	x	x
9	9	x	x	x
10
11
12
Sheet1

Here on sheet2, I have new data that was dragged in from other sources using VBA.

test book.xlsm
	A	B	C	D	E
1	6	y	y	y
2	4	y	y	y
3	8	y	y	y
4	10	x	x	x
5	9	y	y	y
6	10	y	y	y
7
Sheet2

After running your code it correctly recognized that ID 10 was a new entry and placed it perfectly at the first blank row (which was my original difficulty). But there are times that sheet2 will contain a new entry to be put into sheet1 while also having an update to that same unique ID before sheet2 can be filtered into sheet1 (essentially the new and the updated ID are getting entered twice). Also, any updates to new IDs will always be below the new one on sheet2. Sorry if I'm over-explaining, I just want to make sure we are on the same page. Do you have any ideas to make sure two entries don't end up on sheet1 while running the same sub? Much appreciate!

test book.xlsm
	A	B	C	D	E
1	1	x	x	x
2	2	x	x	x
3	3	x	x	x
4	4	y	y	y
5	5	x	x	x
6	6	y	y	y
7	7	x	x	x
8	8	y	y	y
9	9	y	y	y
10	10	x	x	x
11	10	y	y	y
12
Sheet1

 

[DanteAmor]

Just add the blue line

Sub UpdateSheet()
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object
  Dim i As Long, j As Long, fila As Long
  Dim lc1 As Long, lc2 As Long, lc3 As Long, lr1 As Long, lr2 As Long
  Dim sh1 As Worksheet, sh2 As Worksheet
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  Set dic = CreateObject("Scripting.Dictionary")
 
  lc1 = sh1.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  lc2 = sh2.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  lc3 = WorksheetFunction.Max(lc1, lc2)
  lr1 = sh1.Range("A" & Rows.Count).End(3).Row
  lr2 = sh2.Range("A" & Rows.Count).End(3).Row
 
  a = sh1.Range("A1", sh1.Cells(lr1, lc1)).Value
  b = sh2.Range("A1", sh2.Cells(lr2, lc2)).Value
  ReDim c(1 To lr1 + lr2, 1 To lc3)
 
  For i = 1 To UBound(a, 1)
    dic(a(i, 1)) = i
    For j = 1 To UBound(a, 2)
      c(i, j) = a(i, j)
    Next
  Next i
 
  For i = 1 To UBound(b, 1)
    If dic.Exists(b(i, 1)) Then
      fila = dic(b(i, 1))
    Else
      lr1 = lr1 + 1
      fila = lr1
      dic(b(i, 1)) = fila
    End If
    For j = 1 To UBound(b, 2)
      c(fila, j) = b(i, j)
    Next
  Next i
 
  sh1.Range("A1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub

 

[Nole321]

It works perfectly! Thank you so much for your time.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.