Originally Posted by
Wolfgang
hi all..
i have the following data setup:
from a2 to a950 there are entries like a7213 - f3030 - eu112 - gu331 - a7213 - gu331 - gu331 - f3030 - f3030 - f3030 - eu112 - eu112 - ht471 ... and so on...
i like to know which entries occured consecutively as gu331 twice, f3030 three times and eu112 twice ....
i can't use a helper column for the table has 12 columns and i get it from an outside source...
therefore, a macro solution would be nice...
thank you very much...
wolfgang
this should be pretty easy to do, but a few questions:
1. if there is more than one sequence of an entry, how do you want that data displayed?
2. do you care "where" the sequence(s) occur or just which ones and how long? For instance, do you want sequences hi-lited in some way, perhaps with colors?
3. If you can not use other cols in the table, then where do you want the output "shown"?
4. It is always A2 thruogh A950 or could it be other regions?
5. any special handling of blank cells?
The code below should get you started. It is based on some old stuff I had. Most of the code is to display results.
Option Explicit
Sub xlSeqCount()
' Function computes sequence counts
Dim Ans As VbMsgBoxResult
Dim Cell As Range
Dim CellVal As String
Dim Col As Long
Dim I As Long
Dim Num As Integer
Dim NumSeq As Integer
Dim OldCellVal As String
Dim Row As Long
Dim Seq As Boolean
Dim SeqCount(500) As Long
Dim SeqName(500) As String
Dim strBuffer As String
Num = 0
NumSeq = 0
Seq = False
strBuffer = ""
Range("A2:A950").Select
' sequence through each cell in selection
For Each Cell In Selection
Num = Num + 1
' handle 1st cell as special case
If Num = 1 Then
OldCellVal = Cell.Text
GoTo NextCell
End If
' test current cell text against previous cell text
' if the same ==> sequence (either starting or continuing)
CellVal = Cell.Text
If CellVal = OldCellVal Then
' test for continuing or new sequence
If Seq = True Then
SeqCount(NumSeq) = SeqCount(NumSeq) + 1
Else
NumSeq = NumSeq + 1
SeqName(NumSeq) = CellVal
SeqCount(NumSeq) = 2
End If
Seq = True
Else
Seq = False
End If
' retain value of current cell for next comparison
OldCellVal = CellVal
NextCell:
Next Cell
' store count data for display
For I = 1 To NumSeq
If SeqName(I) = "" Then
strBuffer = strBuffer & "<blank>" & " " & SeqCount(I) & vbCrLf
Else
strBuffer = strBuffer & SeqName(I) & " " & SeqCount(I) & vbCrLf
End If
Next I
' display results
MsgBox "xlSeqCount" & vbCrLf & vbCrLf & _
"# cells examined = " & Str(Num) & vbCrLf & _
"# sequences found = " & NumSeq & vbCrLf & vbCrLf & _
"Sequence Names and Counts:" & vbCrLf & strBuffer, vbInformation, "MWETools Utilities"
' write to worksheet?
Ans = MsgBox("Ok to write out results below selection?" & vbCrLf & _
"results will be two cols by " & (NumSeq + 1) & " rows", vbQuestion + vbYesNo)
If Ans <> vbYes Then Exit Sub
Row = Selection.Row + Selection.Rows.Count
Col = Selection.Column
Cells(Row, Col) = "Value"
Cells(Row, Col + 1) = "Count"
For I = 1 To NumSeq
If SeqName(I) <> "" Then
Cells(Row + I, Col) = SeqName(I)
Else
Cells(Row + I, Col) = "<blank>"
End If
Cells(Row + I, Col + 1) = SeqCount(I)
Next I
End Sub
Posting Permissions
Reply With Quote
