ExcelBanter - Counting Values in a different column

Hello Gaby58,

I couldn't do this with Worksheet Formula, but did create a VBA macro
to do this. The macro is designed so all you need to do is select the
first cell of the range and press Ctrl+Shift+C to run the macro. It
will determine the length of the column and then automatically fill in
the count in the cell immediately to the right, as in your example. I
will walk you through how to install the macro in your workbook.
__________________________________________________ _______________

Public Sub CountRepeats()

'Short Cut Keys = Ctrl + Shift + C (In Workbook_Open Event)
'Using the Active Cell on the Active Worksheet...
'Search a sorted list and count repeats by placing a serial
'count in the adjacent column to the Right of the Active Cell.
'
'Example:
' Active Cell = "A1"
' CountRepeats
'
' | A | B |
'------------
'1| abc | 1 |
'2| abc | 2 |
'3| xyz | 1 |
'4| xyz | 2 |
'5| xyz | 3 |

Dim I As Long
Dim C As Long
Dim N As Long
Dim R As Long
Dim Wks As Worksheet

Set Wks = ActiveSheet
With Application.ActiveCell
C = .Column
R = .Row
End With

N = 1

For I = R To Wks.Cells(Rows.Count, C).End(xlUp).Row
Wks.Cells(I, C + 1).Value = N
If Wks.Cells(I, C).Value = Wks.Cells(I + 1, C).Value Then
N = N + 1
Else
N = 1
End If
Next I

End Sub
__________________________________________________ _______________

INSTALLING THE MACRO:

1) Select all the code above between the black lines and copy it using
*Ctrl + C*.
2) Open your Workbook if it isn't already
3) Press *Alt + F11* to open the VBA editor
4) Next Press *Alt + I* to Select Insert
5) Press *M*, this inserts a standard module that will hold the macro
code
6) Paste the code using *Ctrl + V*
7) Save the code by pressing *Ctrl + S*

ASSIGNING THE MACRO'S SHORTCUT KEY.

1) If the VBA Editor isn't visible press *Alt + F11* to open it.
2) In the Upper Left Corner you should see a window titled *Project -
VBA Project*
3) If this window is not visible, press *Ctrl + R* to bring it up
4) Scroll down using the scroll bar on the right, and look for
*ThisWorkbook*
5) *Double Left Click* this entry.
6) Select all the code below between the black lines and copy it using
*Ctrl + C*
7) On the Right Side *Left Click* below the top line *Private Sub
Workbook_Open()*
8) Paste the code using *Ctrl + V*
9) Save the code by pressing *Ctrl + S*
__________________________________________________ _______________

Application.OnKey "^+C", "CountRepeats"
__________________________________________________ _______________

I hope the instructions are clear and you aren't overwhelmed. If you
run in to any problems, you can contact me here at the Forum or by
e-mail to .

Best Wishes,
Leith Ross

--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=355796