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.

 

[LocalNeko]

Hello Again,

I've been gone for a while because I've been busy, but I got it to work thanks to your help.

Here's my final output in case people looking through here need it.

Sub MelCopy()

'counter code
    Dim myMaxVal As Double
    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, "D").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, "D") <> "" And .Cells(LngLp, "AC") = "" Then
                 myMaxVal = myMaxVal + 0.00001 'Increment Number By 1
                .Cells(LngLp, "AC") = myMaxVal  'Put Value in Cell
            End If
        End With


    Next LngLp
    
    GoTo Copy




'Copy Code
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
            Set Dic.Item(Cl.Value) = Cl
        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)
            Else
                Cl.EntireRow.Copy Dic.Item(Cl.Value).Offset(, -28)
            End If
        Next Cl
    End With
    If Not Rng Is Nothing Then Rng.EntireRow.Copy Sheets("MainSheet").Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
End Sub

Basically how it works is that the counter is for the unique identifier of the sheet. After assigning a number for the row, it proceeds to the copy part of the code where if it can't fin the number, it'll add, and if it does find the number, it'll update.

Since I have multiple sheets as sources, I just made a macro for each. It's fine since the sheets are meant for different people.

Thanks again to Fluff for helping me with this, Big help, all the thanks

 

[Fluff]

Glad you sorted it & thanks for the feedback