Counting unique cell values 3

[BetaChick]

     A                          B
1   Debit                3
2   Withdrawal        2
3   Credit               1
4   Withdrawal        2
5   Check              1
6   Debit                3
7   Debit                3

I have XP and Excel ver. 2003

In the above short example Column A has data consistent with the above

Cell B1 has the ancient tried and true formula =countif(A:A,index(A1,1,1))
and was dragged down to B7 Giving Column B results (a count of each unique transaction type)

My spreadsheet has near 4,000 rows so is there an easy sneaky trick to do the following without VBA?

     A                         B                      C
1  Debit                Debit                 3
2  Withdrawal       Withdrawal         2
3  Credit               Credit                1
4  Withdrawal        Check               1
5  Check		
6  Debit		
7  Debit

Thanks In advance
Tricia

 

[SkipVought]

Hi,

It is not at all clear what the logic is for example 2.

And a simpler formula:
[tt]
=countif(A:A,A1)
[/tt]

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[mscallisto]

Thanks for the simpler formula.

Example 2 is the same logic as sample one and reports the counts for each unique type:
3 debits, 2 withdrawals, 1 credit and 1 check
but in a condensed form (only uses the first 4 rows)

In example 1 I currently sort the complete worksheet of 4000 rows, by column B then delete all but the 1st of each unique type.

I know how to do this in VBA but wondered if I can do it as a worksheet formula.

BTW I'm sorry couldn't get my examples to line up with your TGML, I tried code, TT etc.
How does one have columns line-up for data. Code works fine.

Tricia

 

[BetaChick]

Sorry I didn't know I used my husbands logon ID to respond, apparently he had TekTips set to "remember me".

 

[SkipVought]

I'm not accustomed to seeing stuff just stuck together.

Column A is your original data.

Column B is a unique list of the data in column A. Use The unique feature in the Data tab. You can macro record doing that.

Column C is the COUNTIF() results =COUNTIF(A:A,B1)



Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[BetaChick]

Took me a while to figure it out but "The unique feature in the Data tab" was my answer.
Now my =COUNTIF(A:A,B1) gives me what I want.
Thank You
Tricia

 

[Andrzejek]

How does one have columns line-up for data"

Use [ignore][pre] [/pre] [/ignore](pre*serve spacing?) tag:

[pre]
A B
1 Debit 3
2 Withdrawal 2
3 Credit 1
4 Withdrawal 2
5 Check 1
6 Debit 3
7 Debit 3
[/pre]

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[BetaChick]

[pre]Brilliant Andrzejek
Thank You[/pre]

 

[Deniall]

I know that you said you do not want a solution involving VBA.[ ] However the use of Data/Unique has a few disadvantages if you have a primary list that keeps changing.[ ] You have to remember to make a copy of the list, then collapse it.[ ] A cleaner solution is to use a user-defined array-function that takes as input the columnar range from which you wish to extract the unique entries, and produces as output a columnar range that contains only the unique values from the input range.[ ] I had occasion to write one a few years ago, and I include it below for your consideration.[ ] Its main disadvantage from your view point might be that the order of the output items does not match the presentation order in the input range, but in my original context that was an advantage.[ ] (A version to preserve the presentation order would not be to difficult to write.)

Public Function Remove_Dups(In_List As Range)
'
'  Takes as input a column of values.
'
'  Creates from these values a sorted list without duplicates, which
'  is returned to the calling worksheet as an array variable.
'
Dim InRows As Long, InCols As Long, OutRows As Long, OutCols As Long
Dim I As Long, J As Long, NumEntries As Long
Dim ErrText As String
Dim Ans() As Variant, SortedList() As Variant
Const FnName As String = "Function Remove_Dups"
Const EmptyMark As String = "-"
'
'  Get the sizes of the input range and the output range.
'
InRows = In_List.Rows.Count
InCols = In_List.Columns.Count
OutRows = Application.Caller.Rows.Count
OutCols = Application.Caller.Columns.Count
'
'  We now know the required sizes for several VBA arrays, so
'  declare them accordingly.
'
ReDim Ans(OutRows, OutCols)
ReDim SortedList(InRows, 1)
'
'  Apply a few checks to these array sizes before going any further.
'  (Have removed the "OutRows<InRows" test.)
'
If InCols <> 1 Or OutCols <> 1 Or InRows < 2 Then
    ErrText = "Problem with sizes of input or output ranges."
    GoTo ErrorReturn
End If
'
'  Create a VBA array containing the entries to be processed.
'  Skip over empty cells, and also skip cells containing
'  the "EmptyMark".
'
'  (The EmptyMark bit can be changed or dropped as required.)
'
NumEntries = 0
For I = 1 To InRows
    If Not IsEmpty(In_List(I, 1)) And In_List(I, 1) <> EmptyMark Then
        NumEntries = NumEntries + 1
        SortedList(NumEntries, 1) = In_List(I, 1)
    End If
Next I
'
'  If the input range contains no valid entries, go gentle into the night.
'
If NumEntries < 1 Then
    For I = 1 To OutRows
        Ans(I, 1) = EmptyMark       '  Could use "" here instead.
    Next I
    Remove_Dups = Ans
    Exit Function
End If
'
'  Sort the array.
'  Do this using some code filched from the Internet and used in
'  heaps of other places.  It appears below, as part of this module.
'
Call QuickSort(SortedList, 1, 1, NumEntries)
'
'  Scan through the sorted array, grabbing the first instance of
'  each unique entry as we go, and putting it into the output array.
'
J = 1
Ans(1, 1) = SortedList(1, 1)
For I = 2 To NumEntries
    If SortedList(I, 1) <> SortedList(I - 1, 1) Then
        J = J + 1
        If J > OutRows Then
            ErrText = "Output array needs more than " & OutRows & " rows."
            GoTo ErrorReturn
        End If
        Ans(J, 1) = SortedList(I, 1)
    End If
Next I
'
'  Fill the remainder of the output array with "Emptymark".
'
If J < OutRows Then
    For I = J + 1 To OutRows
        Ans(I, 1) = EmptyMark
    Next I
End If
'
'  It's all over, Red Rover.
'
Remove_Dups = Ans
Exit Function
'
'  Error handling area.
'
ErrorReturn:
For I = 1 To OutRows
    Ans(I, 1) = CVErr(xlErrNA)      '  Fill output cells with "#N/A"
Next I
MsgBox ErrText, , FnName
Remove_Dups = Ans
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub QuickSort(SortArray, col, L, R)
'
'  Performs a "quicksort" on a two-dimensional array.
'    SortArray  -  The two-dimensional array to be sorted.
'    col        -  The (single) column number containing the sort key.
'    L          -  The first row number of the band to be sorted.
'    R          -  The last row number of the band to be sorted.
'
'  Always sorts in ASCENDING order.
'
'  Grabbed off Google Groups by Deniall in June 2004.
'
'  Originally Posted by Jim Rech 10/20/98 Excel.Programming
'  Modified to sort on first column of a two dimensional array.
'  Modified to handle a sort column other than 1 (or zero).
'
Dim I As Long, J As Long, mm As Long
Dim x As Variant, y As Variant
'
'  Set new extremes to old extremes.
'  Get sort key for row in middle of new extremes.
'
I = L
J = R
x = SortArray((L + R) / 2, col)
'
'  Loop for all rows between the extremes.
'
While (I <= J)
    '
    '  Find the first row whose key is greater than that of the middle row.
    '
    While (SortArray(I, col) < x And I < R)
        I = I + 1
    Wend
    '
    '  Find the last row whose key is less than that of the middle row.
    '
    While (x < SortArray(J, col) And J > L)
        J = J - 1
    Wend
    '
    '  If the new "greater" row is smaller than the new "lesser" row
    '  swap them, then advance the pointers to the next rows.
    '
    If (I <= J) Then
      For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
        y = SortArray(I, mm)
        SortArray(I, mm) = SortArray(J, mm)
        SortArray(J, mm) = y
      Next mm
        I = I + 1
        J = J - 1
    End If
Wend
'
'  Recurse to sort the lower then the upper halves of the extremes.
'
If (L < J) Then Call QuickSort(SortArray, col, L, J)
If (I < R) Then Call QuickSort(SortArray, col, I, R)
'
End Sub

 

[BetaChick]

Thanks Deniall

Yes I agree the "unique combinations" method requires constant maintenance but I seldom need this data so the "formula" method is simplest for me.

However I will archive this thread with your macro and just may give it a try.

 

[Deniall]

I forgot to add last night that the module in which you put that code will need the line
Option Base 1
at the top in the "Declarations" section.