VBA - Copy Cells from Column A and B and Paste in

Question

Follow up question from this previous post:

VBA - Compare Column on Previous Report With New Report to Find New Entries

The solution below compares a report generated last week with a report generated this week and it finds the differences between the two, in column A. Then it copies the differences from column A to a new sheet into column A. However, the scope has changed slightly in that I need to copy from the original sheet the difference in column A and the adjacent cell in column B.

For example:

Column A contains User ID's and Column B contains Employee Names

The comparison is done on the User ID, and when a difference is found, that specific User ID is copied to the new sheet. However, I need the User ID as well as the Employee Name copied to the new sheet, not just the User ID.

I cannot copy the entire row because there is other information in the other columns that are not necessary for the report summary.

Here is the code provided by Vityata:

    Public Sub FindDifferences()

        Dim firstRange As Range
        Dim secondRange As Range

        Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
        Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
        Dim wks3 As Worksheet: Set wks3 = Worksheets(3)

        Set firstRange = wks1.UsedRange
        Set secondRange = wks2.UsedRange

        Dim myCell  As Range

        For Each myCell In firstRange
            If myCell <> secondRange.Range(myCell.Address) Then
                wks3.Range(myCell.Address) = myCell
            End If
        Next myCell

    End Sub

Here is the current code I have:

Public Sub FindDifferences()

    Dim firstRange As Range
    Dim secondRange As Range
    Dim myCell As Range

    Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet

    'Find Removed Wintel Servers
    Set wks1 = ActiveWorkbook.Sheets("sh1")
    Set wks2 = ActiveWorkbook.Sheets("sh2")
    Set wks3 = ActiveWorkbook.Sheets("sh3")

    Set firstRange = Range(wks1.Range("A1"), wks1.Range("A" & Rows.Count).End(xlUp))
    Set secondRange = Range(wks2.Range("A1"), wks2.Range("A" & Rows.Count).End(xlUp))

    For Each myCell In secondRange
        If WorksheetFunction.CountIf(firstRange, myCell) = 0 Then

            myCell.Copy
            wks3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            wks3.Cells(Rows.Count, 1).End(xlUp).PasteSpecial xlPasteFormats

        End If
    Next myCell

wks3.Range("A1").Select

End Sub

Answer 1

This is probably not the easiest way to do it, but it works for me. Let me know if you need me to explain the different variables.
The code presumes you have headers in the first row on every sheet.

Sub FindDifferences()

    Dim LastRow As Integer
    Dim LastRow2 As Integer
    Dim rng As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rng4 As Range
    Dim Counter As Integer
    Dim Counter2 As Integer


    Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
    Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
    Dim wks3 As Worksheet: Set wks3 = Worksheets(3)

        LastRow = wks1.Cells(Rows.Count, "A").End(xlUp).Row
        LastRow2 = wks2.Cells(Rows.Count, "A").End(xlUp).Row
        Set rng = wks1.Range("A2")
        Set rng2 = wks1.Range("A2:B2")
        Set rng3 = wks2.Range("A2:A" & LastRow2)
        Set rng4 = wks3.Range("A2:B2")
        Counter = 2
        Counter2 = 2

    For x = 1 To LastRow

        Set ValueCheck = rng3.Find(rng.Value, LookIn:=xlValues)

        If ValueCheck Is Nothing Then
        rng2.Copy _
        Destination:=rng4
        Counter2 = Counter2 + 1
        End If

        Counter = Counter + 1
        Set rng = wks1.Range("A" & Counter)
        Set rng2 = wks1.Range("A" & Counter & ":B" & Counter)
        Set rng4 = wks3.Range("A" & Counter2 & ":B" & Counter2)

    Next x

End Sub

Answer 2

In your current code you can replace your line

        myCell.Copy

With this:

.Range(myCell.Address & ":" & myCell.Offset(0,1).Address).Copy

I believe this would work ok, I haven't tested properly, if you get an error let me know I'll trial it