VBA question regarding multiple instances of strings

[rmfrase]

I'm working on a Macro but I'm struggling.
I'm needing to count each instance of unique text strings in a column. (Has a column header "Status".)
The number of each unique text strings will vary from 2 to about 30, but the spreadsheet will have up to several hundred rows with multiples of each. So it's possible to have close to 100 different unique text strings.
The macro starts counting from Row 2 and goes to the last row.
I will then need to display the results in an Alpha order in one column along with the quantity of each in the next.
I tried doing a Pivot Table macro, but kept running into an error 5 as the export constantly has variable row counts.
Any suggestions?

I wanted to try a 2D array (if that's the correct term) like Stat(x,y) where the x was "string" and y the number of instances of x, But couldn't figure how to increment y.

 

[Alex Blakenburg]

What version of Excel are you using and are you on Windows ?
(Please update your profile to show which version)
If you have MS365 or O2021 do you really need to use VBA to do that, they have easy to use functions that could do that.
You could also leverage off these functions in VBA as opposed to using a data dictionary which is a common way of getting unique value in VBA and also for counting or summing values for them.

Power Query would be another option.

 

[Peter_SSs]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

You could probably do this with formulas rather than a macro. Would that be a suitable option?

If you do want a macro, see if you can adapt this. My Status column is column A and the results go into columns F:G

Sub Count_Strings()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    d(a(i, 1)) = d(a(i, 1)) + 1
  Next i
  With Range("F2:G2").Resize(d.Count)
    .Value = Application.Transpose(Array(d.Keys, d.Items))
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
  End With
End Sub

 

[rmfrase]

Your macro example worked perfectly!

 

[Peter_SSs]

Your macro example worked perfectly!

Good news! Thanks for the confirmation.

.. and thanks for updating your version information.

So, with my sample data in column A below, the code I suggested produced the values in columns F:G but note that the formula in cell J2 produces identical results.

rmfrase.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Status
2	a					a	1			a	1
3	b					b	1			b	1
4	g					d	4			d	4
5	f					e	4			e	4
6	r					f	4			f	4
7	g					g	3			g	3
8	f					r	2			r	2
9	d					s	1			s	1
10	e					sw	1			sw	1
11	d					t	1			t	1
12	f					w	7			w	7
13	g					x	1			x	1
14	t
15	r
16	f
17	d
18	d
19	e
20	e
21	e
22	s
23	x
24	sw
25	w
26	w
27	w
28	w
29	w
30	w
31	w
Sheet1

Cell Formulas
Range	Formula
J2:K13	J2	=LET(u,SORT(UNIQUE(A2:A31)),HSTACK(u,COUNTIF(A2:A31,u)))
Dynamic array formulas.

 

[rmfrase]

Thanks. I'm working to have the macro find the column header by name as it's possible that my teams exports may have the status column in a different spot.
Instead of 'A', it may be in 'R'

 

[Peter_SSs]

You have not said where the results should go. This code puts them on the same sheet to the right of any other data on the sheet.
The code assumes that there will always be a cell in row 1 with a value of "Status".

Sub Count_Strings_v2()
  Dim d As Object
  Dim a As Variant
  Dim i As Long, MyCol As Long, LastCol As Long
  
  MyCol = Rows(1).Find(What:="Status", LookAt:=xlWhole, MatchCase:=False).Column
  LastCol = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  a = Cells(1, MyCol).Resize(Cells(Rows.Count, MyCol).End(xlUp).Row).Value
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    d(a(i, 1)) = d(a(i, 1)) + 1
  Next i
  With Cells(1, LastCol + 2).Resize(d.Count, 2)
    .Value = Application.Transpose(Array(d.Keys, d.Items))
    .Cells(1, 2).Value = "Count"
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
  End With
End Sub

 

[rmfrase]

Thank you very much! I was actually able to have a [Tab] added and the results are sent there. I then add in column headers for the rows as well as Percent calculations for the rows and a Total amount (in order to obtain the "% to Total".
The end result looks like what I would have done with a pivot table. Had it not been a pain.

 

[Peter_SSs]

You're welcome. Thanks for the additional information - it seems you are closing in on what you are after.