Check value exists update it or add it

lawlor101

New Member
Joined
Nov 2, 2020
Messages
12
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
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


VBA Code:
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
 

Some videos you may like

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,873
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Nov 2, 2020
Messages
12
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,873
Office Version
  1. 365
Platform
  1. Windows
Ok, how about
VBA Code:
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

New Member
Joined
Nov 2, 2020
Messages
12
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows

ADVERTISEMENT

Ok, how about
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,873
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Nov 2, 2020
Messages
12
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows

ADVERTISEMENT

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,873
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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
 
Solution

lawlor101

New Member
Joined
Nov 2, 2020
Messages
12
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
How about
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,873
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,432
Messages
5,596,088
Members
414,042
Latest member
Swiftkoala

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top