In terms of modifying existing function from earlier thread
Function ModeWord(rngS As Range, rngX As Range, Optional lngRank As Long = 1) As String
Dim oDic As Object, RegExp As Object, RegExpMatch As Object
Dim rngC As Range
Dim lngKey As Long, lngInstance As Long
Dim vTemp As Variant, vKeys As Variant, vKey As Variant
Dim strTemp As String
Set oDic = CreateObject("Scripting.Dictionary")
Set RegExp = CreateObject("vbscript.regexp")
With RegExp
.Global = True
.IgnoreCase = True
.Pattern = "\w+"
End With
For Each rngC In rngS.Cells
Set RegExpMatch = RegExp.Execute(Application.Trim(rngC.Value))
For lngInstance = 1 To RegExpMatch.Count Step 1
strTemp = LCase(RegExpMatch(lngInstance - 1))
With oDic
If Not .exists(strTemp) Then
If Application.CountIf(rngX, strTemp) = 0 Then
.Add strTemp, 1 + 1 - (1 + .Count) / 10000
End If
Else
.Item(strTemp) = .Item(strTemp) + 1
End If
End With
Next lngInstance
Next rngC
Set RegExpMatch = Nothing
With oDic
If lngRank <= .Count Then
ReDim vKeys(1 To .Count, 1 To 2)
For Each vKey In .Keys
lngKey = lngKey + 1
vKeys(lngKey, 1) = vKey
vKeys(lngKey, 2) = .Item(vKey)
Next vKey
vTemp = Application.Match(Application.Large(Application.Index(vKeys, 0, 2), lngRank), Application.Index(vKeys, 0, 2), 0)
ModeWord = vKeys(vTemp, 1) & " (" & Int(vKeys(vTemp, 2)) & ")"
End If
End With
Set oDic = Nothing
End Function
then:
CountResults!A4:
=IF(ROWS(A$4:A4)>$B$1,"",MODEWORD('Raw Data'!$A$1:$A$6,'Stop Words'!$A$1:$A$25,ROWS(A$4:A4)))
copied down to say A53
as before it would make sense to convert this into a Sub Routine rather than run as a UDF and use Input Dialogs to capture ranges etc... (Application.InputBox type 8)
I'm struggling with a cold at present * but I'm sure others can help you with a sub routine in the meantime
*given current goings on in the world all very trivial but the brain isn't working unfortunately
Bookmarks