Counting Unique Record

[Karan001]

Hi Experts,
I have the below given two column.And I would like to have result as shown under the title RESULT.Could you please provide me some Macro or any formula to achieve this.

Name	Company
CAR1	Transport-01
CAR1	Transport-01
ZEEP1	Transport-01
ZEEP1	Transport-01
CAR2	Transport-01
CAR2	Transport-01
B1	Transport-01
B1	Transport-01
B2	Transport-01
B2	Transport-01
CAR3	Transport-02
CAR3	Transport-02
ZEEP2	Transport-02
ZEEP2	Transport-02
CAR4	Transport-02
CAR4	Transport-02
CAR5	Transport-02
CAR5	Transport-02

<colgroup><col style="text-align: center;"><col style="text-align: center;"></colgroup><tbody>
</tbody>

​

RESULT :

Company	Name	Total
Transport-01	CAR	2
Transport-01	ZEEP	1
Transport-01	B	2
Transport-02	CAR	3
Transport-02	ZEEP	1

<colgroup><col style="text-align: center;"><col style="text-align: center;"><col style="text-align: center;"></colgroup><tbody>
</tbody>

Regards,
Kavvya

 

[Fazza]

Thanks, I like it too.

For N > 9, no simple solution AFAIK. So, I'm with you - not sure if it is possible.

If pushed could investigate IIF functions to determine how many digits on the end of the Name. And that feeds in
LEFT(LEN(Name)-some IIF statements to work out how many digits on end of Namefield

It'd be painful for sure

regards

 

[circledchicken]

It'd be painful for sure

regards

ok, thanks for the reply.

 

[Fazza]

You're welcome. And keep going with your many great solutions

 

[circledchicken]

You're welcome. And keep going with your many great solutions

Thankyou!! - that's very kind - I appreciate that!
Its really helpful learning from the posts of all you experts and contributors on the board.

 

[Fazza]

Yes, we all learn from everyone else. The internet has revolutionised learning

 

[apo]

Hi..

I tried a different approach.. I am pretty sure it gets the correct results.. I am only just learning to use the Scripting.Dictionary so any advice on my code from the senior guys here would be most welcome..

I have attached the file below so you can see it working..

Here's the code:

Private Sub CommandButton1_Click()
    Dim i As Long, j As Long, k As Long, kcount As Long, X, Y, Z
    Application.ScreenUpdating = False
    With Sheets("Sheet1").Range("A1").CurrentRegion
        With CreateObject("scripting.dictionary")
            For Each it In Sheets("Sheet1").Columns(2).SpecialCells(2).Offset(1)
                x0 = .Item(it.Value)
            Next
            Z = .keys
            kcount = .Count - 1
        End With
        With CreateObject("scripting.dictionary")
            For Each it In Sheets("Sheet1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                itNew = Left(it.Value, Len(it.Value) - 1)
                x0 = .Item(itNew)
            Next
            X = .keys
        End With
        For i = LBound(X) To UBound(X)
            For j = 0 To kcount - 1
                .AutoFilter 2, Z(j)
                .AutoFilter 1, X(i) & "*"
                With CreateObject("scripting.dictionary")
                    For Each it In Sheets("Sheet1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                        If it = "Name" Then GoTo 1


                        x0 = .Item(it.Value)
                    Next
                    Y = .keys
                    Sheets("Sheet1").Range("A1").CurrentRegion.AutoFilter
                    Cells(Range("E" & Rows.Count).End(xlUp).Row, 5).Offset(1).Value = Z(j)
                    Cells(Range("F" & Rows.Count).End(xlUp).Row, 6).Offset(1).Value = X(i)
                    Cells(Range("G" & Rows.Count).End(xlUp).Row, 7).Offset(1).Value = .Count
                End With
1
            Next j
        Next i
    End With
    Range("E1").CurrentRegion.Sort [E1], 1
    Application.ScreenUpdating = True
End Sub

Car

<b>Sheet1</b><br /><br /><table border="1" cellspacing="0" cellpadding="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:64px;" /><col style="width:135px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:99px;" /><col style="width:64px;" /><col style="width:64px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >Name</td><td >Company</td><td > </td><td > </td><td >Company</td><td >Name</td><td >Total</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >CAR1</td><td >Transport-01</td><td > </td><td > </td><td >Transport-01</td><td >CAR</td><td style="text-align:right; ">2</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >CAR1</td><td >Transport-01</td><td > </td><td > </td><td >Transport-01</td><td >ZEEP</td><td style="text-align:right; ">1</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td >ZEEP1</td><td >Transport-01</td><td > </td><td > </td><td >Transport-01</td><td >B</td><td style="text-align:right; ">2</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td >ZEEP1</td><td >Transport-01</td><td > </td><td > </td><td >Transport-02</td><td >CAR</td><td style="text-align:right; ">3</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td >CAR2</td><td >Transport-01</td><td > </td><td > </td><td >Transport-02</td><td >ZEEP</td><td style="text-align:right; ">1</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td >CAR2</td><td >Transport-01</td><td > </td><td > </td><td >Transport-03</td><td >CAR</td><td style="text-align:right; ">1</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td >B1</td><td >Transport-01</td><td > </td><td > </td><td >Transport-04</td><td >ZEEP</td><td style="text-align:right; ">1</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td >B1</td><td >Transport-01</td><td > </td><td > </td><td >Transport-04</td><td >B</td><td style="text-align:right; ">2</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td >B2</td><td >Transport-01</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td >B2</td><td >Transport-01</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td >CAR3</td><td >Transport-02</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >13</td><td >CAR3</td><td >Transport-02</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >14</td><td >ZEEP2</td><td >Transport-02</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >15</td><td >ZEEP2</td><td >Transport-02</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >16</td><td >CAR4</td><td >Transport-02</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >17</td><td >CAR4</td><td >Transport-02</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >18</td><td >CAR5</td><td >Transport-02</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >19</td><td >CAR5</td><td >Transport-02</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >20</td><td >CAR6</td><td >Transport-03</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >21</td><td >ZEEP8</td><td >Transport-04</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >22</td><td >B3</td><td >Transport-04</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >23</td><td >B4</td><td >Transport-04</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr></table> <br />Excel tables to the web - Excel Jeanie Html 4

 

[Fazza]

hi, apo

Good work, and nicely presented with the code and worksheet sample data. I've added some comments to the code, including about setting 'option explicit' within the VBA editor.

regards, Fazza

Private Sub CommandButton1_Click()
    
    Dim i As Long, j As Long, k As Long, kcount As Long, X, Y, Z
    
    Dim it, x0, itNew 'these were not originally dimmed
    'Really should ALWAYS use 'Option Explicit': turn on via ALT-T-O then 'require variable declaration'
    
    Application.ScreenUpdating = False
    
    With Sheets("Sheet1").Range("A1").CurrentRegion
    
        With CreateObject("scripting.dictionary")
        
        'By going offset(1) the range extends one cell too many. To explain further,
        'the .columns(2) used range is B1:B23. then offset(1) makes it B2:B24 which is
        'one cell further than the data. So last x0 becomes null,
        'and Z has a null as the final entry. Check via view locals window.
        '
        '
        'So instead can use
        'at top, using new variable rngData
        '
        ' with Sheets("Sheet1").Range("A1").CurrentRegion
        '   Set rngData = .offset(1).resize(.rows.count-1)
        ' end with
        '
        ' 'then can have
        ' For Each it In rngData.Columns(2)
        '
        'Also, you're looping through the worksheet cells one at a time. This is a slow operation.
        'Not an issue for small dataset like example. However for large amounts of data it can be.
        'Alternative is to load data from worksheet into an array - a single line of code, and
        'then loop through the array - done quickly in memory.
        '
        ' to load into a variant array
        '  varArray = rngData.value
        
            For Each it In Sheets("Sheet1").Columns(2).SpecialCells(2).Offset(1)
                x0 = .Item(it.Value) 'good to see explicit .value used
            Next
            Z = .keys
            kcount = .Count - 1 'if the suggested resize is done, this would become the more expected kcount = .count
        End With
        
        With CreateObject("scripting.dictionary")
            
            'for each it in rngData.columns(1)
            For Each it In Sheets("Sheet1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                itNew = Left(it.Value, Len(it.Value) - 1) 'Note, as I did in my SQL, assumes single digit ending to string
                x0 = .Item(itNew)
            Next
            X = .keys
        End With
        
        
        'I prefer other approaches to that used from here on.
        'However it works, so that is a great result.
        For i = LBound(X) To UBound(X) 'good to see from LBound to UBound
            For j = 0 To kcount - 1
                .AutoFilter 2, Z(j)
                .AutoFilter 1, X(i) & "*"
                With CreateObject("scripting.dictionary")
                    For Each it In Sheets("Sheet1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                        If it = "Name" Then GoTo 1




                        x0 = .Item(it.Value)
                    Next
                    Y = .keys
                    Sheets("Sheet1").Range("A1").CurrentRegion.AutoFilter
                    Cells(Range("E" & Rows.Count).End(xlUp).Row, 5).Offset(1).Value = Z(j)
                    Cells(Range("F" & Rows.Count).End(xlUp).Row, 6).Offset(1).Value = X(i)
                    Cells(Range("G" & Rows.Count).End(xlUp).Row, 7).Offset(1).Value = .Count
                End With
1
            Next j
        Next i
    End With
    
    Range("E1").CurrentRegion.Sort [E1], 1
    Application.ScreenUpdating = True
    
End Sub

post script. Instead of rng.value it is preferred to use rng.value2 if not dealing with dates. Just a fraction better performance

 

[apo]

Thanks Fazza,

I will go through your comments and see where i could have improved.. thanks for taking the time to give feedback..

 

[Fazza]

You're welcome. With ongoing coding, posting & learning you'll improve. There are many fine coders posting solutions on the forum.

There is a world-class book with more advanced discussion of VBA in Excel. I have the first edition but I'm sure the later edition is even better,

http://www.amazon.com/Professional-Excel-Development-Definitive-Applications/dp/0321508793

I have no affiliation and no benefit from the recommendation, btw

regards