How to match data between columns to do the comparasion

Question

I do not really know how to explain this in a clear manner. Please see attached image

I have a table with 4 different columns, 2 are identical to each other (NAME and QTY). The goal is to compare the differences between the QTY, however, in order to do it. I must: 1. sort the data 2. match the data item by item This is not a big deal with small table but with 10 thousand rows, it takes me a few days to do it.

Pleas help me, I appreciate.

My logic is: 1. Sorted the first two columns (NAME and QTY) 2. For each value of second two columns (NAME and QTY), check if it match with first two column. If true, the insert the value. 3. For values are not matched, insert to new rows with offset from the rows that are in first two columns but not in second two columns

Answer 1

Is this what you are trying?

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, newRow As Long
    Dim aCell As Range, SrchRange As Range

    Set ws = Sheets("Sheet1")

    With ws
        .Columns("A:B").Copy .Columns("G:G")
        .Columns("G:H").Sort Key1:=.Range("G2"), Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
          DataOption1:=xlSortNormal

        lastRow = .Range("G" & Rows.Count).End(xlUp).Row
        newRow = lastRow

        Set SrchRange = .Range("G2:G" & lastRow)

        lastRow = .Range("C" & Rows.Count).End(xlUp).Row

        .Range("I1").Value = "NAME": .Range("J1").Value = "QTY"

        For i = 2 To lastRow
            If Len(Trim(.Range("C" & i).Value)) <> 0 Then
                Set aCell = SrchRange.Find(What:=.Range("C" & i).Value, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not aCell Is Nothing Then
                    .Range("I" & aCell.Row).Value = .Range("C" & i).Value
                    .Range("J" & aCell.Row).Value = .Range("D" & i).Value
                Else
                    newRow = newRow + 1
                    .Range("I" & newRow).Value = .Range("C" & i).Value
                    .Range("J" & newRow).Value = .Range("D" & i).Value
                End If
            End If
        Next
    End With
End Sub

SNAPSHOT

Answer 2

Based on your above requirements, the logic totally changes and hence I am posting it as a different answer.

Also in your "This is Wonderful" snapshot above, there is a slight error. As per logic SAMPLE10 cannot come above SAMPLE11. It has to come after SAMPLE11.

See the below snapshot

And here is the code :)

Option Explicit

Sub sAMPLE()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, newRow As Long, rw As Long
    Dim aCell As Range, SrchRange As Range

    Set ws = Sheets("Sheet1")

    With ws
        .Columns("A:B").Copy .Columns("G:G")
         .Columns("G:H").Sort key1:=.Range("G2"), Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
          DataOption1:=xlSortNormal

        .Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

         lastRow = .Range("G" & Rows.Count).End(xlUp).Row

         For i = 2 To lastRow
            .Range("H" & i).Value = GetLastNumbers(.Range("G" & i).Value)

            If .Range("H" & i).Value <> 0 Then
                .Range("G" & i).Value = Left(.Range("G" & i).Value, _
                Len(.Range("G" & i).Value) - Len(.Range("H" & i).Value))
            End If
         Next i

        .Columns("G:H").Sort key1:=.Range("H2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

        For i = 2 To lastRow
            If .Range("H" & i).Value <> 0 Then _
            .Range("G" & i).Value = .Range("G" & i).Value & .Range("H" & i).Value
        Next i

        .Columns("H:H").Delete

        newRow = lastRow

        Set SrchRange = .Range("G2:G" & lastRow)

        lastRow = .Range("C" & Rows.Count).End(xlUp).Row

        .Range("I1").Value = "NAME": .Range("J1").Value = "QTY"

        For i = 2 To lastRow
            If Len(Trim(.Range("C" & i).Value)) <> 0 Then
                Set aCell = SrchRange.Find(What:=.Range("C" & i).Value, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not aCell Is Nothing Then
                    .Range("I" & aCell.Row).Value = .Range("C" & i).Value
                    .Range("J" & aCell.Row).Value = Application.Evaluate("=SUMPRODUCT((C2:C" & lastRow _
                            & "=" & """" & .Range("C" & i).Value & """" & ")*(D2:D" & lastRow & "))")
                Else
                    newRow = newRow + 1
                    .Range("I" & newRow).Value = .Range("C" & i).Value
                    .Range("J" & newRow).Value = .Range("D" & i).Value
                End If
            End If
        Next
        lastRow = .Range("G" & Rows.Count).End(xlUp).Row
        For i = lastRow To 2 Step -1
            If .Range("G" & i).Value = .Range("G" & i - 1).Value Then
                .Range("H" & i - 1).Value = .Range("H" & i).Value + .Range("H" & i - 1).Value
                If Application.WorksheetFunction.CountA(.Range("I" & i & ":J" & i)) = 0 Then
                    .Range("G" & i & ":J" & i).Delete Shift:=xlUp
                Else
                    .Range("G" & i & ":H" & i).Delete Shift:=xlUp
                End If
            End If
        Next i

        lastRow = .Range("I" & Rows.Count).End(xlUp).Row
        newRow = .Range("G" & Rows.Count).End(xlUp).Row

        If lastRow <= newRow Then Exit Sub

        .Range("I" & newRow & ":J" & lastRow).Sort key1:=.Range("I" & newRow), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

        For i = lastRow To newRow Step -1
            If .Range("I" & i).Value = .Range("I" & i - 1).Value Then
                .Range("J" & i - 1).Value = .Range("J" & i).Value + .Range("J" & i - 1).Value
                .Range("I" & i & ":J" & i).Delete Shift:=xlUp
            End If
        Next i
    End With
End Sub

Function GetLastNumbers(strVal As String) As Long
    Dim j As Long, strTemp As String

    For j = Len(strVal) To 1 Step -1
        If Not IsNumeric(Mid(strVal, j, 1)) Then Exit For
        strTemp = Mid(strVal, j, 1) & strTemp
    Next j
    GetLastNumbers = Val(Trim(strTemp))
End Function