View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone Jim Cone is offline
external usenet poster
 
Posts: 3,290
Default Solve Using VBA Routine

Jim,

You are welcome and thanks for passing the formula along.
You may find, like me, that once you start programming,
it seems to be easier to write code rather than figure out formulas.

For what it's worth, replace the second occurrence of "Jon"
with "Alex", and see what you get using the array formula.

Regards,
Jim Cone


"Jim May" wrote in message
news:fK5Ud.23258$7z6.18254@lakeread04...
Thanks Jim for the additional comments;
appreciate your help on this.

PS:
I later came across a formula approach (as follows):
In Cell C2 (and copy down)..
{=COUNT(IF(($A$2:$A$11=A2)*($B$2:$B$11<=B2),$B$2:$ B$11))}
enter as CSE type.
Jim May




"Jim Cone" wrote in message
...
Jim,

Only two things...
The variables have not been declared and
most of the "Select" statements are not needed.

I particularly like the way you incremented the Column C values.
For what it's worth, do not assume a "UsedRange" will always
start in row one. Of course, in this case it does.
'Slightly revised code follows...
'------------------------------------
Sub Foo()
Dim Mrows As Long
Dim i As Long
Dim n As Long
Dim p As Long

Range("D1").Value = "AutoNo"
' ActiveSheet.UsedRange.Offset(0, 3).Resize(, 1).Select
' Mrows = Selection.Rows.Count
Mrows = ActiveSheet.UsedRange.Rows.Count '*** Added

For i = 2 To Mrows
Cells(i, 4).Value = i
Next i

ActiveSheet.UsedRange.Sort Key1:=Range("A1"), _
Order1:=xlAscending, Key2:=Range("B1"), _
Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
' Range("C2:C" & Mrows).Select
p = 0

For n = 2 To Mrows
If Cells(n, 1).Value = Cells(n + 1, 1) Then
p = p + 1
Cells(n, 3).Value = p
Else
Cells(n, 3).Value = p + 1
p = 0
End If
Next n

' Range("A1").Select
ActiveSheet.UsedRange.Sort Key1:=Range("D1"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Columns("D:D").Delete
Range("A1").Select
End Sub
'---------------------------------------

Regards,
Jim Cone
San Francisco, USA