It's a little messy as I used a little space at the bottom of the "Parse"
worksheet to list the elements of "sGroup" for sorting by the Excel
worksheet function, but it's a whole lot easier (and runs faster) than
writing my own sort routine...
HTH,
Shockley
Sub Tester()
Sheets("GroupCount").Cells.ClearContents
Dim arr(1 To 3) As Double
With Sheets("Parse")
Set rngSort = Range(.Cells(65534, 1), .Cells(65536, 1))
.Activate
LastRow = .Cells(65536, 1).End(xlUp).Row
For i = 1 To LastRow
For j = 1 To 4
n = 0
For k = 1 To 4
If k < j Then
n = n + 1
rngSort(n) = .Cells(i, k)
End If
Next k
rngSort.Sort _
Key1:=rngSort(1), _
Order1:=xlAscending, _
Header:=xlNo
LastCell = .Cells(i, 256).End(xlToLeft).Column
For n = 1 To 3
.Cells(i, LastCell + 1 + n) = rngSort(n)
sGroup = sGroup & rngSort(n)
Next n
rngSort.Value = Empty
With Sheets("GroupCount")
LastGroupRow = .Cells(65536, 1).End(xlUp).Row
If .Cells(1, 1) = Empty Then LastGroupRow = 0
.Cells(LastGroupRow + 1, 1) = sGroup
End With
sGroup = ""
Next j
Next i
End With
With Sheets("GroupCount")
.Activate
Columns(1).Sort _
Key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlNo
r = 1
LastGroup = ""
Do
If .Cells(r, 1) < LastGroup Then
.Cells(r, 2) = Application.WorksheetFunction. _
CountIf(.Columns(1), .Cells(r, 1))
LastGroup = .Cells(r, 1)
Else: .Cells(r, 1) = Empty
End If
r = r + 1
Loop Until .Cells(r, 1) = Empty
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireR ow.Delete
End With
End Sub
"Michael168" wrote in message
...
Your module works great, except on the groupcount routine.
As stated it is a group count, so I prefer to group the identical
numbers in a single group and count it. Instead of the 3 or 6 groups
and count individually.
e.g.
123 = 1
132 = 2
213 = 1
231 = 1
312 = 2
321 = 2
Instead of above count and display, it will be much easier to look at a
single group like below
123 = 9 (Box)
Your modifications will be very helpful.
Thanks & Regards
Michael168
------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/