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
 

lawlor101

New Member
Joined
Nov 2, 2020
Messages
12
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
You're welcome & thanks for the feedback.
Hi Again Fluff.

I've ran some extra checks on this and it seems that data says "changed" even when nothing on the line has been changed.

Its like stated as changed once its found? I assume 1 extra if statement should fix this? Any ideas?
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,311
Office Version
  1. 365
Platform
  1. Windows
It can be done, but that would mean having to check each & every cell to see if it has changed, which could slow down the code considerably.
 

lawlor101

New Member
Joined
Nov 2, 2020
Messages
12
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
It can be done, but that would mean having to check each & every cell to see if it has changed, which could slow down the code considerably.
yeah I figured that...
could you add it, I can test the time taken and decide which would be better, the risk of misinformation or extra time!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,311
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
   Dim Changed As Boolean
   
   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
               If Ary1(r, c) <> Ary2(.Item(Ary1(r, 11)), c) Then Changed = True
               Ary1(r, c) = Ary2(.Item(Ary1(r, 11)), c)
            Next c
            If Changed Then
               Ary1(r, UBound(Ary1, 2)) = "Changed"
            Else
               Ary1(r, UBound(Ary1, 2)) = ""
            End If
            Changed = False
            .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

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
   Dim Changed As Boolean
  
   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
               If Ary1(r, c) <> Ary2(.Item(Ary1(r, 11)), c) Then Changed = True
               Ary1(r, c) = Ary2(.Item(Ary1(r, 11)), c)
            Next c
            If Changed Then
               Ary1(r, UBound(Ary1, 2)) = "Changed"
            Else
               Ary1(r, UBound(Ary1, 2)) = ""
            End If
            Changed = False
            .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
Logic looks right to me but it still defaults to "changed" even when I duplicated the data to ensure nothing can be different. :(
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,311
Office Version
  1. 365
Platform
  1. Windows
If I run that with the 1st sheet totally blank I get New in AE & then if I run it again col AE is totally blank as nothing is different.
 

lawlor101

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

ADVERTISEMENT

If I run that with the 1st sheet totally blank I get New in AE & then if I run it again col AE is totally blank as nothing is different.
Confusing why it would be different.

It is not the case for me and sheet1 will have the top two rows also in it now also drags in row 2 from the sheet2 into sheet1.

It recognizes new, but still always changed on mine. Ive emptied sheet 1 and ran, it gets pasted with a gap above. Not sure how else to explain
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,311
Office Version
  1. 365
Platform
  1. Windows
Do you have any formulae on the second sheet?
 

lawlor101

New Member
Joined
Nov 2, 2020
Messages
12
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
I dont have any forumulas in either of the sheets, Ive duplicated the file and fixed the name and ran the macro and it still appears as changed. Very strange consider there cannot be anything different.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,311
Office Version
  1. 365
Platform
  1. Windows
Are you using the code from post#14, or did you modify your code?
If the latter can you please post the code your using.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,343
Messages
5,601,073
Members
414,426
Latest member
fraru

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