Adding the exact IDs

[hakunamatata]

Hello Everybody,
I want to add the exact ids and rearrange them accordingly, for the sake of example workbook is attached with this thread.

[Teeroy]

Hi hakunamatata, couldn't you do this by PivotTable?

[hakunamatata]

Hi, thanks alot for your reply. Actually i need something like pivot table but not pivot table. Pivot table gives the sum but i need the ids first then sum of that ids.

[hakunamatata]

Hello Teeroy,If some solution exists then please let me now, i need it badly.

[Teeroy]

Hi hakunamatata, try the following. It's only designed for A-C TEA ID per your example but you could add more to aID in the code:

Sub SortandSum()
Dim LR1 As Integer, LR2 As Integer
Dim i As Integer, j As Integer, Count1 As Integer, Count2 As Integer
Dim aID
Dim rDest1 As Range, rDest2 As Range, rDestSub As Range
Dim colLengths() As Integer
aID = Array("A", "B", "C")
ReDim colLengths(UBound(aID))
With Sheets("Sheet1")
    'define data ranges
    LR1 = .Range("A" & .Rows.Count).End(xlUp).Row
    LR2 = .Range("D" & .Rows.Count).End(xlUp).Row
    'determine max no. of data values (ID1 or ID2)
    For i = 0 To UBound(aID)
        Count1 = Application.WorksheetFunction.CountIf(.Range("A9:A" & LR1), aID(i))
        Count2 = Application.WorksheetFunction.CountIf(.Range("D9:D" & LR2), aID(i))
        colLengths(i) = max(Count1, Count2)
    Next i
    'Set up receiving sheet
    With Sheets("Sheet2")
        .Range("B1").Resize(1, 6) = Array("TEA ID1", "Value1", , , "TEA ID2", "Value2")
        Set rDestSub = .Range("A1")
        Set rDest1 = .Range("B2")
        Set rDest2 = .Range("F2")
    End With
    'Receive the data
    For i = 0 To UBound(colLengths)
        For j = 1 To max(LR1, LR2)
             If .Cells(j, 1) = aID(i) Then
                 rDest1.Value = aID(i)
                 rDest1.Offset(0, 1).Value = .Cells(j, 2)
                Set rDest1 = rDest1.Offset(1, 0)
            End If
            If .Cells(j, 4) = aID(i) Then
                rDest2.Value = aID(i)
                rDest2.Offset(0, 1).Value = .Cells(j, 5)
                Set rDest2 = rDest2.Offset(1, 0)
            End If
        Next j
        Set rDestSub = rDestSub.Offset(colLengths(i) + 1, 0)
        rDestSub.Resize(1, 7) = Array("Sum", aID(i), Application.WorksheetFunction.SumIf(.Range("A9:A" & LR1), aID(i), .Range("B9:B" & LR1)) _
        , , "Sum", aID(i), Application.WorksheetFunction.SumIf(.Range("D9:D" & LR1), aID(i), .Range("E9:E" & LR1)))
        Set rDest1 = rDestSub.Offset(1, 1)
        Set rDest2 = rDestSub.Offset(1, 5)
    Next i
End With
End Sub

Function max(i As Integer, j As Integer)
If i > j Then
    max = i
Else
    max = j
End If
End Function

[hakunamatata]

Hello,Thanks for your code i am getting confuse because my worksheet was from A-E can you please attach the worksheet in which you attest the code.

[Teeroy]

Hi hakunamatata, A-C = the values of the TEA ID (i.e. A, B or C) , not the columns. See the attached copy of your workbook where I tested the code.

[hakunamatata]

thanks alot for your help. Works perfect.

[hakunamatata]

Hello TeeroyThe code that you have written works fine, but the problem is that in array it stores only 3 values, but i have more than 1000 Ids which i cant save in array is it possible that it takes the full volumn instead of array.

[Teeroy]

Hi hakunamatata, the code was written in a way that you only have to change the aID array to handle this. Now that you've said that there are 1000+ IDs I've incorporated a great Chip Pearson Function to get the distinct values and feed the array. See how this works for you.

[hakunamatata]

Hello Teeroy,
Now your Macro works good in my project, Actually when i implement it in my project then i miss some thing, which i forget to mention you in my first Post. Please take a look at the attach workbook i have explain it there, just need a very little change in current code.
Thanks again for your help.

[Teeroy]

Hi hakunamatata, try the attached.

For your information, if you reuse the DistinctValues Function and pass arrays you must set Option Base 1. I'd only used it with ranges before and found this hard way .

[hakunamatata]

Hello Teeroy,

The program that you have written works absolutely perfect. You are a genius,
Thanks alot for your help.