VBA - Comparing two sheets and placing the difference on the second sheet

[LocalNeko]

Hello Once Again.

I've been working on a project that I previously posted here. Looking at it from another angle, I think I found a solution where-in I need help.

Here is the code I am Using

Sub SheetCompare()
    Sheets(6).Activate   '6 is the main sheet
    'Cells.Clear         'and clear all previous results
    Dim LastRow As Integer
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    MsgBox LastRow
    Range("A" & LastRow + 1).Select  'set cursor at the top
    
    Sheets(17).Activate  'go to sheet 1 '17 is sheet 1
    Range("a1").Select  'begin at the top
    


    
    Dim search_for As String   'temp variable to hold what we need to look for
    Dim cnt As Integer         'optional counter to find out how many rows we found
    
    Do While ActiveCell.Value <> ""   'repeat the follwoing loop until it reaches a blank row
        
        search_for = ActiveCell.Offset(0, 1).Value   'get a hold of the value in column B
        
        Sheets(6).Activate  'go to sheet(6)
        
        On Error Resume Next   'incase what we search for is not found, no errors will stop the macro
        
        Range("b:b").Find(search_for).Select  'find the value in column B of sheet 6
        
        If Err <> 0 Then   'If the value was not found, Err will not be zero
        
            On Error GoTo 0  'clearing the error code
            
            Sheets(17).Activate   'go back to sheet 1
            
            r = ActiveCell.Row   'get a hold of current row index
            
            Range(r & ":" & r).Select  'select the whole row
            
            cnt = cnt + 1   'increment the counter
            
            Selection.Copy  'copy current selection
            
            Sheets(17).Activate  'go to sheet 17
            
            Range("A" & LastRow + 1).Select
            
            Selection.PasteSpecial xlPasteAll  'Past the entire row to sheet 17
            
            ActiveCell.Offset(1, 0).Select  'go down one row to prepare for next row.
            
            
        End If
        Sheets(1).Activate   'return to sheet 1
        ActiveCell.Offset(1, 0).Select   'go to the next row
        
    Loop   'repeat
    
    Sheets(6).Activate    'go to sheet 3 to examine findings
    
    MsgBox "I have found " & cnt & " rows that did not exist in sheet 2"
    
End Sub

Now that code would compare the two sheets but based only on column B. That's where I need help.

I need help so that the two sheets would compare based on the rows, not columns. Because I need the rows to be exactly matched for me not to copy/exactly different for me to copy.

I hope It's not as confusing as the first question.
Please Help.

Thank you.

 

[Fluff]

How about

Sub LocalNeko()
    Dim Cl As Range, Rng As Range
    Dim Dic As Object
    
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets(6)
        For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
            .Item(Cl.Value) = Empty
        Next Cl
    End With
    With Sheets(17)
        For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
            If Not .exists(Cl.Value) Then
                If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
            End If
        Next Cl
    End With
    If Not Rng Is Nothing Then Rng.EntireRow.Copy Sheets(6).Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
End Sub

 

[LocalNeko]

Hello Fluff,

First of all I would like to say THANK YOU SO MUCH. This code gave me an idea of what it is I need to do. Thankyou!
With that A few quesetions

This code gave out an error

[COLOR=#333333].Item(Cl.Value) = Empty[/COLOR]

So I edited it to this(Based on searching)

Dic[COLOR=#333333].Item(Cl.Value) = Empty[/COLOR]

Another question is that your code only reads all cell from cell b?(A.K.A cell b is the unique identifier?) Is it really difficult to read and match each row?
Because if it is I guess I could try to provide a unique identifier on column B.(With a few edit to your code). Like using a counter to place numbers on cell B and using that as a unique identifier.

But again Thank you for replying, sorry for the late reply. Hope to hear your answer.

 

[Fluff]

Firstly, the correction you made is correct.

Secondly, it does use col B as a unique identifier as that is what you asked for

compare the two sheets but based only on column B

If you want to compare based on every value in the row, what is the first & last column in your data?

 

[LocalNeko]

Thanks for being patient.

First:
Whoops, Sorry about that,

Secondly, it does use col B as a unique identifier as that is what you asked for

What I meant on my first post (very top) was that I was using code that also compared based on the column B value. (I think? Based on my debugging). I could've worded it better I guess. My bad.

Second:
My columns are from A:AB. As for why I need it to compare to every value in the row is because the data being placed on the sheet is added and updated.
So for example:

<code class=" language-plain" id="result-code" style="padding: 0px; font-family: "Ubuntu Mono", Monaco, Menlo, Consolas, monospace; border-radius: 3px; background-color: transparent; border: 0px; text-shadow: rgb(255, 255, 255) 0px 1px; max-height: 25em; direction: ltr; word-spacing: normal; overflow: auto; word-break: normal; overflow-wrap: normal; tab-size: 4; hyphens: none; position: relative;">(Main Sheet)
+------+------+------+
| NAME | ID | Room |
+------+------+------+
| Zac | 2002 | b2 |
+------+------+------+
| John | 2004 | c3 |
+------+------+------+
| Dave | 2008 | d4 |
+------+------+------+
(Sheet 1)
+------+------+------+
| NAME | ID | Room |
+------+------+------+
| Zac | 2002 | b2 |
+------+------+------+
| John | 2014 | f3 |
+------+------+------+
| Dave | 2008 | d4 |
+------+------+------+
| Ryu | 2019 | e5 |
+------+------+------+

After running the macro it would be

<code class=" language-plain" id="result-code" style="padding: 0px; font-family: "Ubuntu Mono", Monaco, Menlo, Consolas, monospace; border-radius: 3px; background-color: transparent; border: 0px; text-shadow: rgb(255, 255, 255) 0px 1px; max-height: 25em; direction: ltr; word-spacing: normal; overflow: auto; word-break: normal; overflow-wrap: normal; tab-size: 4; hyphens: none; position: relative;">(Main Sheet)
+------+------+------+
| NAME | ID | Room |
+------+------+------+
| Zac | 2002 | b2 |
+------+------+------+
| John | 2014 | f3 |
+------+------+------+
| Dave | 2008 | d4 |
+------+------+------+
| Ryu | 2019 | e5 |
+------+------+------+
(Sheet 1)
+------+------+------+
| NAME | ID | Room |
+------+------+------+
| Zac | 2002 | b2 |
+------+------+------+
| John | 2014 | f3 |
+------+------+------+
| Dave | 2008 | d4 |
+------+------+------+
| Ryu | 2019 | e5 |
+------+------+------+

So basically I'm trying to add and update the main sheet based on multiple sheets.(I only used sheet 1 for the example but there are multiple sheets that the data could be coming from).

The added(new) data should always be at the very bottom of the main sheet while the data that needs to be updated should be overwritten.

I'm not sure if this is a complicated project or if I'm just very new at this but thank you for your time and patience I really appreciate it.

P.S.
Glad my edit(correction) to the error was right. At least it means I'm learning bit by bit haha.

</code>



</code>

 

[Fluff]

With that example, could you have John on multiple sheets & if so how do we determine which of those entries would override the main sheet?

 

[LocalNeko]

Well I was working on it today, And I added this for the very last column(So basically my data is now from A to AC)

Dim myMaxVal As Long    Dim ColKLRow As Long
    Dim mySht As Worksheet
    Dim name As String
    name = "M"
    
    Set mySht = Sheets("Mel") 'Change Accordingly
    myMaxVal = Application.WorksheetFunction.Max(Range("AC2:AC10000")) 'Get Max Value in K <---Adjust Range Accordingly
    ColKLRow = mySht.Cells(Rows.Count, "Z").End(xlUp).Row 'Get Last Row Column J
    
    'Cycle through values in J and K and look for empties...
    For LngLp = 2 To ColKLRow
    
        With mySht
            If .Cells(LngLp, "Z") <> "" And .Cells(LngLp, "AC") = "" Then
                 myMaxVal = myMaxVal + 1  'Increment Number By 1
                .Cells(LngLp, "AC") = myMaxVal  'Put Value in Cell
            End If
        End With


    Next LngLp

Its a counter, basically turns the example above to
[FONT=&quot](Main Sheet)[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| NAME | ID | Room |Counter[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| Zac | 2002 | b2 |1[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| John | 2014 | f3 |2[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| Dave | 2008 | d4 |3[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| Ryu | 2019 | e5 |4[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot](Sheet 1)[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| NAME | ID | Room |Counter[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| Zac | 2002 | b2 |1[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| John | 2014 | f3 |2[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| Dave | 2008 | d4 |3[/FONT]
[FONT=&quot]+------+------+------+[/FONT]
[FONT=&quot]| Ryu | 2019 | e5 |4[/FONT]
[FONT=&quot]+------+------+------+

Because yes I was also thinking of a way to assign a unique identifier to the file. Not sure if this is a good way of doing it but it works to a degree since it would always start at the highest value it could find at the column.

So yeah counter column (AC) acts as my unique identifier. "John with Counter 2" is different with "John with Counter 5"

Thank you again for your help Fluff ^^[/FONT]

 

[Fluff]

Glad you got it sorted & thanks for the feedback

 

[LocalNeko]

Wait, Fluff, I haven't sorted out the update part. T_T

Sub MelCopy()


    Dim myMaxVal As Long
    Dim ColKLRow As Long
    Dim mySht As Worksheet
    
    Set mySht = Sheets("Mel") 'Change Accordingly
    myMaxVal = Application.WorksheetFunction.Max(Range("AC2:AC10000")) 'Get Max Value in K <---Adjust Range Accordingly
    ColKLRow = mySht.Cells(Rows.Count, "Z").End(xlUp).Row 'Get Last Row Column J
    
    'Cycle through values in J and K and look for empties...
    For LngLp = 2 To ColKLRow
    
        With mySht
            If .Cells(LngLp, "Z") <> "" And .Cells(LngLp, "AC") = "" Then
                 myMaxVal = myMaxVal + 1  'Increment Number By 1
                .Cells(LngLp, "AC") = myMaxVal  'Put Value in Cell
            End If
        End With


    Next LngLp
    
    GoTo Copy


Copy:
    Dim Cl As Range, Rng As Range
    Dim Dic As Object
    
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("MainSheet")
        For Each Cl In .Range("AC2", .Range("AC" & Rows.Count).End(xlUp))
            Dic.Item(Cl.Value) = Empty
        Next Cl
    End With
    With Sheets("Mel")
        For Each Cl In .Range("AC2", .Range("AC" & Rows.Count).End(xlUp))
            If Not Dic.exists(Cl.Value) Then
                If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
            End If
        Next Cl
    End With
    If Not Rng Is Nothing Then Rng.EntireRow.Copy Sheets("Main Sheet").Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
End Sub

That's the current code I'm running(with your help),but it doesn't update the ones with matching numbers(AC column), just adds the new ones below. So it add but doesn't update.

Any help you can provide with this?

 

[Fluff]

Ok, how about

    With Sheets("MainSheet")
        For Each Cl In .Range("AC2", .Range("AC" & Rows.Count).End(xlUp))
            [COLOR=#ff0000]Set Dic.Item(Cl.Value) = Cl[/COLOR]
        Next Cl
    End With
    With Sheets("Mel")
        For Each Cl In .Range("AC2", .Range("AC" & Rows.Count).End(xlUp))
            If Not Dic.exists(Cl.Value) Then
                If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
           [COLOR=#ff0000] Else
                Cl.EntireRow.Copy Dic.Item(Cl.Value).Offset(, -28)[/COLOR]
            End If
        Next Cl
    End With