VBA help to identify most frequently occurring text

L

Legacy 462862

Guest
Hi,

I've used the following to identify the most frequently occurring text in my sheet:

- - -

Function Freq(rng As Range) As String

Dim cll As Range
Dim lngCount As Long
Dim lngMax As Long
Dim str As String

Set dic = CreateObject("scripting.dictionary")

On Error Resume Next

For Each cll In rng

If cll.Value <> "" Then
dic(cll.Value) = dic(cll.Value) + 1
lngCount = dic(cll.Value)
If lngCount > lngMax Then
lngMax = lngCount
str = cll.Value
End If
End If
Next

On Error GoTo 0

Freq = str

End Function

- - -

Does anyone know what needs to be changed to identify the 2nd, 3rd, 4th, 5th etc? Or a different way of doing it?

Thanks!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,135
Office Version
  1. 365
Platform
  1. Windows
Without being able to see your data, there's nothing much I can do unfortunately.
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
L

Legacy 462862

Guest
No problem, thanks for your help so far.

The code in post 26 pulls the right names but has the wrong numerical value. Is there a way of just pulling the names?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,135
Office Version
  1. 365
Platform
  1. Windows
Yup, you can use
VBA Code:
Sub zoersdn()
   Dim Ary As Variant, Kth As Variant
   Dim r As Long, i As Long, NxtRw As Long
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   Ary = Range("N11:X21").Value2
   NxtRw = UBound(Ary) + 10
   
   For r = 2 To UBound(Ary)
      For i = 1 To UBound(Ary, 2)
         If Ary(r, i) <> "" Then
            Dic(Ary(r, i)) = Dic(Ary(r, i)) + 1
         End If
      Next i
   Next r
   ReDim Ary(1 To Dic.Count, 1 To 2)
   Kth = Application.Large(Dic.Items, 10)
   If IsError(Kth) Then Kth = Application.min(Dic.Items)
   r = 0
   
   For i = 0 To Dic.Count - 1
      If Dic.Items()(i) >= Kth Then
         r = r + 1
         Ary(r, 1) = Dic.Keys()(i)
      End If
   Next i
   Range("N" & NxtRw).Resize(r).Value = Ary
End Sub
 
L

Legacy 462862

Guest
Sub zoersdn() Dim Ary As Variant, Kth As Variant Dim r As Long, i As Long, NxtRw As Long Dim Dic As Object Set Dic = CreateObject("scripting.dictionary") Dic.CompareMode = 1 Ary = Range("N11:X21").Value2 NxtRw = UBound(Ary) + 10 For r = 2 To UBound(Ary) For i = 1 To UBound(Ary, 2) If Ary(r, i) <> "" Then Dic(Ary(r, i)) = Dic(Ary(r, i)) + 1 End If Next i Next r ReDim Ary(1 To Dic.Count, 1 To 2) Kth = Application.Large(Dic.Items, 10) If IsError(Kth) Then Kth = Application.min(Dic.Items) r = 0 For i = 0 To Dic.Count - 1 If Dic.Items()(i) >= Kth Then r = r + 1 Ary(r, 1) = Dic.Keys()(i) End If Next i Range("N" & NxtRw).Resize(r).Value = Ary End Sub

Thanks!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,135
Office Version
  1. 365
Platform
  1. Windows
You're welcome.
 

Watch MrExcel Video

Forum statistics

Threads
1,132,644
Messages
5,654,552
Members
418,140
Latest member
ahepple86

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top