Check value exists update it or add it

[lawlor101]

Hi Everyone, I have issue with VBA with For next loops and verifying data.

Right now this macro does 2/3 of what I want, but I cannot get it to add the row on the end if it does not find it.

My goal is to check wb2 column "k" values against wb1 column "k" values and update if its their, and add if its not.


Am I over complicating this? I could really use some help here. Thanks

Public Sub Complete()
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    End With
    
Dim wb1 As Workbook, wb2 As Workbook
    Set wb1 = Workbooks("data-first.xlsm")
    Set wb2 = Workbooks("data-second.xlsm")

Dim wb1s As Worksheet, wb2s As Worksheet
    Set wb1s = Workbooks("data-first.xlsm").Worksheets(1)
    Set wb2s = Workbooks("data-second.xlsm").Worksheets(1)

Dim q As Long



        For q = 3 To wb2s.Rows.Count
            LastRowUpdate = wb2s.Cells(wb2s.Rows.Count, "K").End(xlUp).Row
            For y = 3 To LastRowUpdate 'wb1 movement
                If wb2s.Cells(y, 11) = wb1s.Cells(q, 11) Then
                    For i = 1 To 30 ' For the rows
                        If wb2s.Cells(y, i).Value <> wb1s.Cells(q, i).Value Then
                            wb1s.Cells(q, i) = wb2s.Cells(y, i)
                        End If
                    Next i 'End of the rows sub
                ElseIf wb2s.Cells(y, 11) <> wb1s.Cells(q, 11) Then
                    LastRowMaster = wb1s.Cells(wb1s.Rows.Count, "K").End(xlUp).Row
                    For v = q To LastRowMaster
                        If wb2s.Cells(y, 11) = wb1s.Cells(v, 11) Then
                            For i = 1 To 30 ' For the rows
                                If wb2s.Cells(y, i).Value <> wb1s.Cells(v, i).Value Then
                                    wb1s.Cells(v, i) = wb2s.Cells(y, i)
                                    'here we can say add value to last column to show change. (same above)
                                End If
                            Next i 'End of the rows sub
                            Else:
                        End If
                    Next v
                    End If
                
                Next y
            Next q 'end wb2 movement
            
                
            
    With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    End With
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Will the values in col K exists once only in each workbook?
Also roughly how many rows of data do you have?

 

[lawlor101]

Hi & welcome to MrExcel.
Will the values in col K exists once only in each workbook?
Also roughly how many rows of data do you have?

Thanks, great community here!
Yes, its a unique ID field so it will exist once only. It will be about 18 thousand rows in each workbook. The "update" workbook will likely have slightly more each time because of new records.

 

[Fluff]

Ok, how about

Sub lawlor()
   Dim Ary1 As Variant, Ary2 As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   With Workbooks("data-first.xlsm").Worksheets(1)
      Ary1 = .Range("A3:AD" & .Range("K" & Rows.Count).End(xlUp).Row)
   End With
   With Workbooks("data-second.xlsm").Worksheets(1)
      Ary2 = .Range("A3:AD" & .Range("K" & Rows.Count).End(xlUp).Row)
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary2)
         .Item(Ary2(r, 11)) = r
      Next r
      For r = 1 To UBound(Ary1)
         If .Exists(Ary1(r, 11)) Then
            For c = 1 To UBound(Ary1, 2)
               Ary1(r, c) = Ary2(.Item(Ary1(r, 11)), c)
            Next c
            .Remove Ary1(r, 11)
         End If
      Next r
      If .Count > 0 Then
         ReDim Nary(0 To .Count - 1, 1 To UBound(Ary2, 2))
         For nr = 0 To .Count - 1
            r = .items()(nr)
            For c = 1 To UBound(Ary2, 2)
               Nary(nr, c) = Ary2(r, c)
            Next c
         Next nr
      End If
   End With
   With Workbooks("data-first.xlsm").Worksheets(1)
      .Range("A3").Resize(UBound(Ary1), UBound(Ary1, 2)).Value = Ary1
      If IsArray(Nary) Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2)).Value = Nary
   End With
End Sub

 

[lawlor101]

Ok, how about

Sub lawlor()
   Dim Ary1 As Variant, Ary2 As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   With Workbooks("data-first.xlsm").Worksheets(1)
      Ary1 = .Range("A3:AD" & .Range("K" & Rows.Count).End(xlUp).Row)
   End With
   With Workbooks("data-second.xlsm").Worksheets(1)
      Ary2 = .Range("A3:AD" & .Range("K" & Rows.Count).End(xlUp).Row)
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary2)
         .Item(Ary2(r, 11)) = r
      Next r
      For r = 1 To UBound(Ary1)
         If .Exists(Ary1(r, 11)) Then
            For c = 1 To UBound(Ary1, 2)
               Ary1(r, c) = Ary2(.Item(Ary1(r, 11)), c)
            Next c
            .Remove Ary1(r, 11)
         End If
      Next r
      If .Count > 0 Then
         ReDim Nary(0 To .Count - 1, 1 To UBound(Ary2, 2))
         For nr = 0 To .Count - 1
            r = .items()(nr)
            For c = 1 To UBound(Ary2, 2)
               Nary(nr, c) = Ary2(r, c)
            Next c
         Next nr
      End If
   End With
   With Workbooks("data-first.xlsm").Worksheets(1)
      .Range("A3").Resize(UBound(Ary1), UBound(Ary1, 2)).Value = Ary1
      If IsArray(Nary) Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2)).Value = Nary
   End With
End Sub

It doesnt seem to work. It recognizes the value is there but then doesnt change the row. Let me try be a little more specific.

There is data in columns A:AD. The top two rows are headers (I have therefore changed the value of r in the above into 3).

The unique key is located in K.
st reply
Upload Image

If wb2 K value matches any wb1 k value then I want to update the row in wb1 where wb2 cells <> wb1 cells.

Right now it is difficult for me to follow so I would add in a "has been changed" column at the end if it has been changed so that I could know it works.

Currently working with about 8 records to test if it is working.

 

[Fluff]

I have therefore changed the value of r in the above into 3

In that case please change it back, it already starts on row 3.
The code updates the Data-First workbook, with whatever is in the data-second workbook.

 

[lawlor101]

In that case please change it back, it already starts on row 3.
The code updates the Data-First workbook, with whatever is in the data-second workbook.

Mr.Fluff I believe you are correct. Thank you very much. I searched far and wide for this and I'm sure many will reuse this code.

While I have you here, can you add in a line of code that adds a "changed" value to a new column in the end, if it has been changed or added? for verifying data purposes.

 

[Fluff]

How about

Sub lawlor()
   Dim Ary1 As Variant, Ary2 As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   With Workbooks("data-first.xlsm").Worksheets(1)
      Ary1 = .Range("A3:AE" & .Range("K" & Rows.Count).End(xlUp).Row)
   End With
   With Workbooks("data-second.xlsm").Worksheets(1)
      Ary2 = .Range("A3:AD" & .Range("K" & Rows.Count).End(xlUp).Row)
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary2)
         .Item(Ary2(r, 11)) = r
      Next r
      For r = 1 To UBound(Ary1)
         If .Exists(Ary1(r, 11)) Then
            For c = 1 To UBound(Ary1, 2) - 1
               Ary1(r, c) = Ary2(.Item(Ary1(r, 11)), c)
            Next c
            Ary1(r, UBound(Ary1, 2)) = "Changed"
            .Remove Ary1(r, 11)
         End If
      Next r
      If .Count > 0 Then
         ReDim Nary(0 To .Count - 1, 1 To UBound(Ary1, 2))
         For nr = 0 To .Count - 1
            r = .Items()(nr)
            For c = 1 To UBound(Ary2, 2)
               Nary(nr, c) = Ary2(r, c)
            Next c
            Nary(nr, UBound(Ary1, 2)) = "New"
         Next nr
      End If
   End With
   With Workbooks("data-first.xlsm").Worksheets(1)
      .Range("A3").Resize(UBound(Ary1), UBound(Ary1, 2)).Value = Ary1
      If IsArray(Nary) Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2)).Value = Nary
   End With
End Sub

 

[lawlor101]

How about

Sub lawlor()
   Dim Ary1 As Variant, Ary2 As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   With Workbooks("data-first.xlsm").Worksheets(1)
      Ary1 = .Range("A3:AE" & .Range("K" & Rows.Count).End(xlUp).Row)
   End With
   With Workbooks("data-second.xlsm").Worksheets(1)
      Ary2 = .Range("A3:AD" & .Range("K" & Rows.Count).End(xlUp).Row)
   End With
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary2)
         .Item(Ary2(r, 11)) = r
      Next r
      For r = 1 To UBound(Ary1)
         If .Exists(Ary1(r, 11)) Then
            For c = 1 To UBound(Ary1, 2) - 1
               Ary1(r, c) = Ary2(.Item(Ary1(r, 11)), c)
            Next c
            Ary1(r, UBound(Ary1, 2)) = "Changed"
            .Remove Ary1(r, 11)
         End If
      Next r
      If .Count > 0 Then
         ReDim Nary(0 To .Count - 1, 1 To UBound(Ary1, 2))
         For nr = 0 To .Count - 1
            r = .Items()(nr)
            For c = 1 To UBound(Ary2, 2)
               Nary(nr, c) = Ary2(r, c)
            Next c
            Nary(nr, UBound(Ary1, 2)) = "New"
         Next nr
      End If
   End With
   With Workbooks("data-first.xlsm").Worksheets(1)
      .Range("A3").Resize(UBound(Ary1), UBound(Ary1, 2)).Value = Ary1
      If IsArray(Nary) Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2)).Value = Nary
   End With
End Sub

Perfect. Great. Thank you so much. Hope you have a great week!!

 

[Fluff]

You're welcome & thanks for the feedback.