Reputation: 957
I have a large range of values, with some blanks in between, and I was wondering how I could find the of total all the different values, each with their own total in that range.
For example, I have (in the range A1:D5):
| Low | Low | --- | Low |
| Low | High| --- | Low |
| --- | --- | --- | --- |
| Pie | --- | Low | High|
| --- | --- | Low | --- |
I would like the program to spit out:
(in a range or a msgbox or anything, the user needs to write down the numbers)
High: 2
Low: 7
Pie: 1
What I've tried:
I tried using the CountIF
function, but have been having problems figuring it out properly.
I have well over 800 lines to test for, so I'd like to avoid iterating through every line in a simple for loop.
Bonus points:
(I'd be happy with an answer to just the above, but if someone could figure this out too it would be much appreciated)
There are some cell values which compose of muliple instances of a word or even muliple words.
For example, a few cells contain
Low
Low
separated only by a carriage return. There is even one cell in this current month that contains
Low
Low
High
Low
Low
I would also like to count each occurrence inside the cells, so the above cell would give the output:
High: 1
Low: 4
Upvotes: 0
Views: 1141
Reputation: 5281
Try the .find method. Go to your VBA help, look up the range.find method for some more info - it also provides some code that you should be able to modify easily.
I'd suggest using a counter for each value that updates each time you have a find. For example:
Dim Low_count As Long
Low_count = 0
With Worksheets(1).Range("a1:a500")
Set c = .Find("Low", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Low_count = Low_count + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Upvotes: 1
Reputation: 26670
Give this a try:
Sub tgr()
Dim cllUnq As Collection
Dim rngCheck As Range
Dim CheckCell As Range
Dim arrUnq(1 To 65000) As String
Dim arrCount(1 To 65000) As Long
Dim varWord As Variant
Dim MatchIndex As Long
Dim lUnqCount As Long
On Error Resume Next
Set rngCheck = Application.InputBox("Select the cells containing strings to be counted", "Select Range", Selection.Address, Type:=8)
On Error GoTo 0
If rngCheck Is Nothing Then Exit Sub 'Pressed cancel
Set cllUnq = New Collection
For Each CheckCell In rngCheck.Cells
For Each varWord In Split(CheckCell.Text, Chr(10))
If Len(Trim(varWord)) > 0 Then
On Error Resume Next
cllUnq.Add varWord, varWord
On Error GoTo 0
If cllUnq.Count > lUnqCount Then
lUnqCount = cllUnq.Count
arrUnq(lUnqCount) = CStr(varWord)
arrCount(lUnqCount) = 1
Else
MatchIndex = WorksheetFunction.Match(CStr(varWord), arrUnq, 0)
arrCount(MatchIndex) = arrCount(MatchIndex) + 1
End If
End If
Next varWord
Next CheckCell
If lUnqCount > 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
With Range("A1:B1")
.Value = Array("Word", "Count")
.Font.Bold = True
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
Range("A2").Resize(lUnqCount).Value = Application.Transpose(arrUnq)
Range("B2").Resize(lUnqCount).Value = Application.Transpose(arrCount)
End If
Set cllUnq = Nothing
Set rngCheck = Nothing
Set CheckCell = Nothing
Erase arrUnq
Erase arrCount
End Sub
Upvotes: 3