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

 

[lawlor101]

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?

 

[Fluff]

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]

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]

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
   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]

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
   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]

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]

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]

Do you have any formulae on the second sheet?

 

[lawlor101]

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]

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.